E-Mail Absenderkonto via VBA ändern
06.10.2014 17:03:26
lee
habe folgenden Code zusammengebaut, aber beim Absender habe ich ein Problem. Das Programm Outlook mit dem PDF Anhang wird geöffnet, aber der Absender ändert sich nicht. Vielleicht kann mir jemand weiterhelfen?
Danke+Gruß
lee
Sub AlsPDFSpeichern_und_senden()
Dim pdfName As String
Dim pdfOpenAfterPublish As Boolean
Dim olApp As Object
Dim strStandDatum As String
Dim strWorkbook As String
Rem Rückfragen, ob Datei nach dem Erstellen geöffnet werden soll
If MsgBox("Soll die PDF-Datei nach dem Erstellen angezeigt werden?", vbYesNo, "PDF anzeigen?") = _
vbYes Then pdfOpenAfterPublish = True
Rem Pfad und Name der PDF-Datei
strStandDatum = Left(Date, 2) & Right(Left(Date, 5), 2) & Right(Date, 4) ' z.B. 02102014
strWorkbook = ActiveWorkbook.Name
pdfName = ThisWorkbook.Path & "\test " & strStandDatum & ".pdf"
Rem PDF-Datei erstellen. Funktioniert nur in Excel 2007 oder höher, nicht in Excel 2003 oder ä _
lter
Workbooks(strWorkbook).Sheets("Report").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
_
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=IIf(pdfOpenAfterPublish, True, False)
Rem Email erstellen
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.TO = Workbooks(strWorkbook).Sheets("E-Mail").Cells(1, 2).Value
'.CC = Range("Z2").Value
.Subject = Workbooks(strWorkbook).Sheets("E-Mail").Cells(2, 2).Value & Date
.htmlBody = Workbooks(strWorkbook).Sheets("E-Mail").Cells(3, 2).Value & "
" & " _
" & Workbooks(strWorkbook).Sheets("E-Mail").Cells(4, 2).Value & "
" & "
" & Workbooks(strWorkbook).Sheets("E-Mail").Cells(6, 2).Value & "
" & Workbooks(strWorkbook).Sheets("E-Mail").Cells(7, 2).Value & "
" & Workbooks(strWorkbook).Sheets("E-Mail").Cells(8, 2).Value
.Attachments.Add pdfName
.SendUsingAccount = .Session.Accounts.Item("mustermann@mustermann.com")
.Display
End With
Rem Boolean-Variable "pdfOpenAfterPublish" zurücksetzen
pdfOpenAfterPublish = False
End Sub