Send ark sommeddelesestekst via VBA

Kan dette hjælpe?
Sub Email()
ActiveWorkbook.SendMail recipients:="julesne@julemand.com"(email adressen)
End Sub

Hej

Nej egentlig ikke. Ovenstående sender filen som vedhæftet, jeg skal have den sendt som meddelelsestekst.
og jeg skal finde mailadresserne (2 stk) i arket

Desværre.....

Jeg mener desværre ikke at det, du vil kan lade sig gøre. Du kan sende et ark som vedhæftet fil, men ikke som en del af meddelelsesteksten. Du kan evt. gøre det via automation, men det kræver sandsynligvis at brugeren anvender Outlook.

Hej

Brugerne anvender Outlook, så det er ikke noget problem.

Jeg ser lige på det og vender tilbage.

Tak det glæder jeg mig til.
Hvis det kan lade sig gøre er det vigtigt at den kan tage mail-adresserne i arket, for det er forskelligt hvor det skal sendes hen.

Her er et forsøg. Jeg har ikek selv outlook på min hjemme pc, så jeg har ikke afprøvet metoden, men den burde virke. Den første kode sender mailen. Adresserne tages fra A1 og A2 i regnearket, men det kan du selv ændre om nødvendigt. Den sender hele arket som en del af teksten, men KUN det ark, du står i når du sender. Det er IKKE muligt at lægge flere ark ind i meddelelsen som tekst. Den anden del af koden (funktionen) kaldes af den første og omdanner arket til HTM format, som kan indsættes i en mail. Har du brug for yderligere information om, Excel og E-mail kan jeg anbefale Ron de Bruins hjememside, hvor der er manbge eksempler. Her har jeg fx "stjålet" funktionen til omdannelse af ark til htm.

Husak at du under Tools - references i VBA editoren skal sætte flueben ved Microsoft Outlook xx.x Object Library. Nummer afhænger af din version af Outlook.

Sub Send_via_Outlook()
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem
Dim szBodyTekst As String
Dim sig As Signature
Set olApp = New Outlook.Application
Set olNewMail = CreateItem(olMailItem)
szBodyTekst = "Hermed fremsendes nye regneark" & vbCr
'szBodyTekst = szBodyTekst & "mvh" & vbCr
'szBodyTekst = szBodyTekst & "Tommy Bak" & vbCr


With olNewMail
    .Recipients.Add Range("a1")
    .Recipients.Add Range("a2")
    .Subject = "Nye regneark"
    .HTMLBody = SheetToHTML(ActiveSheet)
    .Send
End With
Set olNewMail = Nothing
Set olApp = Nothing

End Sub

Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003
    Dim TempFile As String
    Dim Nwb As Workbook
    Dim myshape As Shape
    Dim fso As Object
    Dim ts As Object
    sh.Copy
    Set Nwb = ActiveWorkbook
    For Each myshape In Nwb.Sheets(1).Shapes
        myshape.Delete
    Next
    TempFile = Environ$("temp") & "/" & _
    Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    Nwb.SaveAs TempFile, xlHtml
    Nwb.Close False
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    SheetToHTML = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    Set Nwb = Nothing
    Kill TempFile
End Function

De to udkommenterede linier 'sz.... samt linien szbodytekst kan du roligt slette.

Det ser godt ud. jeg kan først teste det i morgen , men jeg glæder mig allerede.
;o)))))) (stort smil!!!!!!!!)

OK. Jeg er måske ikke på i morgen, men lad mig lige vide om det virker.

Hej jkrons

Det virker helt super!!!!

You rock!!!!!!!!!!!!!!!!!!!!!!!

Mvh Lise

Jkrons -> "De to udkommenterede linier 'sz.... samt linien szbodytekst kan du roligt slette."

tak for det :-)

bak-> Det var såmæbnd ikke for at fratage dig æren for den del af koden bak. Og jeg giver såmænd gerne pointene til dig. Jeg menter bare at de var overflødige fordi koden ikke bruger body mend htmlbody.

Det ved jeg godt jkrons, det var såmænd bare for at drille lidt. Jeg har jo selv klonet den fra en en anden :-)

:-)