Hallo zusammen,
ich habe ein Problem mit einem Makro:
ich habe eine Excel Datei in der sich Mailadressen und Ansprechpartner befinden sowie der Pfand für einen Anhang.
nun möchte ich für die Rund 60 Empfänger die Individuelle Mail mit unterschiedlichen Anhangen erstellen lassen und in die entwürfe speichern lassen.
es funktioniert auch alles einwandfrei, bis auf eine Sachen....
wenn ich erst den Text einfüge und dann die Signatur rutscht der Text immer unter die Signatur auch wenn ich vorher sage SendKeys "{END}", True.
Wenn ich erst die Signatur und dann den Text einfüge löscht er den vorherig eingefugten Text raus und ersetzt ihn durch die Signatur.
Vielen Dank für Tipps im Voraus!
liebe Grüße Marvin
'##################### Daten in Mail einfügen#############################
Dim name As String
Dim maili As String
Dim mailcc As String
Dim betreff As String
Dim anhang As String
Dim i As Long
Dim olapp As Object
Dim str As String
Dim str_design1 As String
Dim str_design2 As String
Dim str_satz1 As String
Dim str_satz2 As String
Dim str_ende As String
Dim str_Signatur As String
'Application.ScreenUpdating = False
i = 2 'ab Zeile 2 werden die Einträge für E-Mail adressen gesucht
While Worksheets("Adressen").Cells(i, 1).Value ""
str = "" 'kann leer bleiben
maili = Worksheets("Adressen").Cells(i, 1).Value 'Mailadresse in Spalte A
name = Worksheets("Adressen").Cells(i, 2).Value 'Ansprechpartner Spalte B
anhang = Worksheets("Adressen").Cells(i, 5).Value 'Pfad zum Anhang in Spalte E
mailcc = "" 'kann leer bleiben
betreff = "BETREFF_BETREFF_BETREFF"
Set olapp = CreateObject("Outlook.Application")
str_design1 = ""
str_design2 = ""
str = str_design1 & "Guten Tag " & name & ",
" & str_design2
str_satz1 = str_design1 & "TEXT_TEXT_TEXT_TEXT.
" & str_design2
str_ende = str_design1 & "Mit freundlichen Grüßen
TEXT_TEXT_TEXT" & str_design2
str = str & str_satz1 & str_satz2 & str_ende
With olapp.CreateItem(0)
.HtmlBody = str
.To = maili
.Subject = betreff
.cc = mailcc
.attachments.Add anhang
.Display
SendKeys "{END}", True
str_Signatur = "extern"
.getinspector.CommandBars.Item("Insert").Controls("signatur").Controls(str_Signatur).Execute
.Save
End With
Set olapp = Nothing
i = i + 1
Wend
Application.ScreenUpdating = True
MsgBox "Email im Outlook - Entwürfe gespeichert!" & vbNewLine & "Daten vor Versand prüfen!", vbInformation, " Fertig"
End Sub