VBA Email mit Anhang als PDF
21.04.2021 22:21:21
Marko
wieder einmal benötige ich Eure Hilfe. Folgende Aufgabe möchte ich lösen.
1.Mit diesem Code erzeuge ich eine E-Mail mit Anhang als PDF:
Private Sub CommandButton1_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
msg = MsgBox(Sheets("Tabelle2").Range("BE8").Value, vbYesNo, "Microsoft Outlook")
If msg = vbYes Then
Dim app As Object
Dim file As String
Dim isNew As Boolean
Dim olApp As Object
Dim olOldBody As String
file = Sheets("Tabelle2").Range("BC3").Text & ".pdf"
Sheets("Tabelle2").Range("B3:AB61").ExportAsFixedFormat xlTypePDF, Environ("TEMP") & "\" & file
On Error Resume Next
Set app = GetObject(, "Outlook.Application")
If app Is Nothing Then
Set app = CreateObject("Outlook.Application")
isNew = True
End If
With app.CreateItem(0)
.To = Sheets("Tabelle2").Range("BF5").Value
.Cc = ""
.BCC = ""
.Subject = Sheets("Tabelle2").Range("BC3").Value
.Body = "Hallo " & Sheets("Tabelle2").Range("BF7").Value & "," & vbCrLf & vbCrLf _
& "mit dieser E-Mail erhalten Sie die Übersicht für den Zeitraum: " _
& Sheets("Tabelle2").Range("BE4").Value & "." & vbCrLf & vbCrLf _
& "Haben Sie Fragen? Rufen Sie mich bitte an. " & vbCrLf & vbCrLf _
& " Sie erreichen mich am besten unter der Telefonnummer 0123-456789." & vbCrLf & vbCrLf _
& "Mit freundlichen Grüßen" & vbCrLf & vbCrLf _
& "Max Mustermann" & vbCrLf & vbCrLf _
.Attachments.Add Environ("TEMP") & "\" & file
.ReadReceiptRequested = True 'Lesebestätigung ein
.Display 'Email anzeigen
.GetInspector.CommandBars.Item("Insert").Controls("Signatur").Controls(strSignatur).Execute
End With
If isNew Then app.Quit
Else
MsgBox "Keine E-Mail erstellt!", vbOKOnly, "Microsoft Outlook"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
2. Mit diesem Code erzeuge ich PDF's von allen Kunden und speichere diese lokal auf meinem Rechner ab: Sub alleKundenToPdf_2()
'Kunden Liste
Dim ZAdr As String
ZAdr = Worksheets("Tabelle6").Range("F1")
For i = 2 To ZAdr
With Sheets("Tabelle2")
.Range("BC4") = Sheets("CRM_Kunden").Cells(i, 4).Value
.Calculate
.Range("A11:A60").AutoFilter Field:=1, Criteria1:="x", visibledropdown:=False
.Application.Wait Now + TimeSerial(0, 0, 1)
.Calculate
file = Environ("USERPROFILE") & "\Documents\" & "\Kunden\" & Sheets("Tabelle2").Range("BC3").Text & ".pdf"
Sheets("Tabelle2").Range("B3:AB61").ExportAsFixedFormat xlTypePDF, file
End With
Next
End Sub Ich möchte beide Codes miteinander kombinieren und die erzeugten PDF's - direkt- als E-Mail versenden (erstmal .Display). Hierbei benötige ich Eure Unterstützung.
Vielen Dank im Voraus.
Gruß, Marko