Mehrere PDF per Mail versenden
26.02.2024 08:15:59
Timo
ich brauche bitte wieder einmal eure Hilfe. Ich suche schon seit Stunden anch Codeschnipseln, um mir meine gewünschte Funktion zu erstellen, aber ich bekomme es einfach nicht hin.
Ich habe 2 Exceldateien, beide liegen im selben Ordner. Von Datei 1 erstelle ich von Tabelle2 eine PDF, von Tabelle 2 werden 2 Tabellenblätter exportiert und im selben Ordner gespeichert. Den Export erledigt dieser Code:
Tabelle2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", "") & "_LS", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Tabelle3.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", "") & "_GS", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=TrueHiermit werden dann Tabelle 2 und 3 exportiert, Dateiname ist der Name der Exceldatei plus es werden _LS bzw. _GS angehangen. In der andere Exceldatei ist es dann Tabelle3 mit gleichem Code.
Jetzt würde ich gerne die bereits erstellten PDF direkt als Anhang nach Outlook senden. Hierfür habe ich mir folgenden Code gesucht:
Sub Beispiel_PDF_Mail_NEU()
Dim sPathPDF$
Dim objOutlook As Object, objMail As Object
'PDF erstellen
With ThisWorkbook
'Pfad wo die PDF gespeichert werden soll, hier wo die Excel liegt
sPathPDF = IIf(Right$(.Path, 1) = "\", .Path, .Path & "\")
'Pfad + PDF-File-Name, hier wird der Name der Excel verwendet
sPathPDF = sPathPDF & Left(.Name, InStrRev(.Name, ".")) & "pdf"
'Abfrage ob Datei ersetzt werden soll, bei nein Abbruch
If Dir(sPathPDF, vbNormal) > "" Then
If MsgBox("Die PDF wurden bereits erstellt, sollen sie überschrieben werden?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
Tabelle3.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sPathPDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
'Mail erstellen ************************************
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Mustermann@MusterProviter.de" 'An-Empfänger
.CC = "" 'Cc-Empfänger
.BCC = "" 'BCc-Empfänger
.Subject = "Betreff" 'Betreff
.Body = "Mail Nachricht" 'Nachricht
.Attachments.Add sPathPDF 'Anlage
.Display 'Mail anzeigen
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Mit diesem Code wird dann 1 Datei exportiert und eine E-Mail erstellt und die PDF angehangen.
Jetzt stehe ich vor 3 Herausforderungen:
1: Ich schaffe es zwar, hier eine 2. Datei nach Outlook als Anhang zu schicken, aber der Dateiname ändert sich und es wird nur der Name der Exceldatei angegeben. Somit habe ich zwar 2 Anhänge, die heißen aber beide gleich. Ich brauche die Unterscheidung zwischen _LS und _GS. Ich benötige jedoch auch meinen Zusatz. Bei Tabelle 2 _LS und Tabelle 3 _GS im Dateinamen. Egal was ich hier auch im Code versuche, er sendet zwar was nach Outlook allerdings kommt dann die Meldung "Pfad fehlerhaft" und der Anhang kann nicht geöffnet werden.
2: Schön wäre es, wenn alle PDF Dateien aus dem Ordner als Anhang verschickt werden könnten. Denn auch aus Exceldatei 1 wird ebenfalls eine PDF erstellt. Der Dateiname ist ebenfalls der der Exceldatei plus _REF angehangen.
Wie kann ich entweder "Alle PDF Dateien als Anhänge aus dem Ordner versenden" - oder - eine weitere Datei der selben E-Mail anhängen. Also in Tabelle 1 wird ein Anhang an Outlook gesendet, aus Tabelle 2 sollen beide PDF exporte ebenfalls in die selbe E-Mail.
3: Meine Signatur soll benfalls noch in der Mail hinterlegt werden. Das habe ich auch noch nicht geschafft.
Ohje, sorry für den langen Text, aber ich tue mich schwer mit der Erklärung.
Danke für Eure Unterstützung.
LG Timo
