Hallo zusammen
Ich kenne mich mit VBA nicht gut aus und würde gerne eine Funktion erstellen, die vom Excel aus eine Mail per Outlook versendet. Die Mail soll sich auf eine Bestellliste derselben Arbeitsmappe beziehen. Ich habe nun mit diversen Vorlagen eine Funktion zusammengebastelt, welche nun immer am Laufzeitfehler '9' Index ausserhalb des gültigen Bereichs scheitert. Meine Funktion sieht wie folgt aus:
Public Sub Send_Email()
'-------------< Send_Email() >-------------
Dim sTitle As String
sTitle = "Bestellung"
'< HMTL holen >
Dim sTemplate As String
'</ HMTL holen >
Dim ws As Worksheet
Set ws = Sheets("_programm")
'----< Send with Outlook >----
Dim app_Outlook As Outlook.Application
Set app_Outlook = New Outlook.Application
Dim objEmail As Outlook.MailItem
With objEmail
'< Fill Placeholders >
Dim sHTML As String
Dim varChar
For Each varChar In Sheets("_text").Shapes(1).TextFrame2.TextRange.Characters
Dim char_Text As String
char_Text = varChar.Text
char_Text = Replace(char_Text, vbCrLf, "<br>")
char_Text = Replace(char_Text, vbLf, "<br>")
Next
sHTML = sHTML & char_Text
Dim tblBestellliste As ListObject
Set tblBestellliste = ws.ListObjects("tblBestellliste")
Dim iRow As Integer
For iRow = 2 To tblBestellliste.ListRows.Count
Next
Dim sText As String
sText = sHTML
Dim iCol As Integer
For iCol = 1 To tblBestellliste.ListColumns.Count
Dim sPlaceholder As String
sPlaceholder = tblBestellliste.Range(1, iCol)
sPlaceholder = Trim(sPlaceholder)
Dim sValue As String
sValue = tblBestellliste.Range(iRow, iCol)
sValue = Trim(sValue)
'< replace >
If Not sPlaceholder Like "" Then
sText = Replace(sText, "[@" & sPlaceholder & "]", sValue, , , vbTextCompare)
End If
Next
'--< Send Email >--
Set objEmail = app_Outlook.CreateItem(olMailItem)
objEmail.To = "email@mail.com"
objEmail.Subject = sTitle
objEmail.HTMLBody = sText
objEmail.Display False
objEmail.Send
End With
End Sub
Hat mir jemand einen Tipp?
Danke und beste Grüsse
Mike
|