Makro
02.07.2015 00:18:45
Torsten
Kann man es so verändern, das die Email gleich versendet wird?
Danke für die Hilfe.
Gruß Torsten
Option Explicit
Sub Bereich_Mail()
EMAIL_Senden "XXXXXXXXXXXXXX;", Tabelle6.Range("G2").Value, Tabelle6.Range("A2:D2")
End Sub
Private Sub EMAIL_Senden(Empfänger As String, Betreff As String, rngBody As Range)
Dim MyOutApp As Object, MyMessage As Object
Dim sPath$, sHTMLBody$, sInhalt$
Dim F%
sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
sPath = sPath & "tmpHTMLFile.html"
ThisWorkbook.PublishObjects.Add( _
xlSourceRange, _
sPath, _
rngBody.Parent.Name, _
rngBody.Address, _
xlHtmlStatic).Publish (True)
F = FreeFile
Open sPath For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close
Kill sPath
sInhalt = Replace(sInhalt, "align=center", "align=left")
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = Empfänger '"Hier kommt die Adresse rein"
.CC = ""
.Bcc = ""
.Subject = Betreff '"Text für Betreffzeile"
.htmlBody = sInhalt
.Display
'.Attachments.Add sPath
'.Send 'Hier wird die Mail gesendet
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub