Simples Makro läuft nicht mehr
23.12.2018 12:50:11
Hennes
bis vor einem halben Jahr funktionierte das unten aufgeführte Makro problemlos. Mit ihm habe ich aus einer Excel-Datei heraus eine Email mit Anhang versendet. Aber jetzt, Monate nach der letzten Nutzung, bleibt es stets an der gleichen Stelle hängen. Kann mir jemand helfen, das Makro wieder flott zu machen?
Freundliche Grüße
Hennes
Public Sub Outlook_Mail_DE()
'WerbeEmailDE
Const TEMP_FILE = "D:\SST_Buchhaltung.xlsm" 'Pfad und Dateiname anpassen !!!
Const FLYER = "D:\Flyer DE.pdf"
Dim objOutlook As Object
Dim objMail As Object
If Dir$(TEMP_FILE) vbNullString Then Call Kill(TEMP_FILE)
Worksheets("WerbeEmailDE").Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=TEMP_FILE
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to = Worksheets("WerbeEmailDE").Range("O2").Text
.Attachments.Add FLYER
.SentOnBehalfOfName = "order@chessstamps.com"
.Subject = Worksheets("WerbeEmailDE").Range("B4").Text
.Body = Worksheets("WerbeEmailDE").Range("B6").Text & vbLf & Worksheets("WerbeEmailDE"). _
_
_
Range("B9").Text _
& vbLf & vbLf & Worksheets("WerbeEmailDE").Range("B11").Text & vbLf & Worksheets(" _
WerbeEmailDE").Range("B12").Text & vbLf & Worksheets("WerbeEmailDE").Range("B13").Text _
& vbLf & Worksheets("WerbeEmailDE").Range("B15").Text _
& vbLf & vbLf & Worksheets("WerbeEmailDE").Range("B17").Text & vbLf & Worksheets(" _
WerbeEmailDE").Range("B18").Text & vbLf & Worksheets("WerbeEmailDE").Range("B19").Text _
& vbLf & Worksheets("WerbeEmailDE").Range("B21").Text _
& vbLf & vbLf & Worksheets("WerbeEmailDE").Range("B22").Text & vbLf & Worksheets(" _
WerbeEmailDE").Range("B23").Text & vbLf & Worksheets("WerbeEmailDE").Range("B24").Text
.Display 'nur Anzeigen
.SendUsingAccount = "order@chessstamps.com"
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
