VBA: Blatt als pdf per Mail. Blatt mit anderen pdfs vereinen

Sub SUK_Rechnung_Speichern_Und_Versenden()

    On Error GoTo ErrorHandler ' Fehlerbehandlung aktivieren



    Dim ws As Worksheet

    Dim savePath As String

    Dim fileName As String

    Dim outlookApp As Object

    Dim outlookMail As Object

    Dim emailRecipient As String

    Dim emailSubject As String

    Dim emailBody As String

    Dim subjectCell As Range ' Variable für Betreffzeile

    Dim attachmentPath As String ' Pfad zu den Anhängen

    Dim command As String ' Befehlszeile für Ghostscript



    ' Arbeitsblatt mit den Daten

    Set ws = ThisWorkbook.Sheets("SUK Rechnung")

    

    ' Pfad zum Speichern des PDFs

    savePath = "W:\"

    

    ' Dateiname aus Zelle K11 auslesen

    fileName = ws.Range("K11").Value

    

    ' PDF speichern

    ws.ExportAsFixedFormat Type:=xlTypePDF, fileName:=savePath & "\" & fileName & ".pdf", Quality:=xlQualityStandard

    

    ' Betreffzeile auslesen

    Set subjectCell = ws.Range("K12") ' Annahme: Betreff ist in Zelle K12

    emailSubject = subjectCell.Value ' Wert der Betreffzeile zuweisen

    

    ' Outlook-Instanz erstellen

    Set outlookApp = CreateObject("Outlook.Application")

    Set outlookMail = outlookApp.CreateItem(0)

    

    ' Empfänger der E-Mail

    emailRecipient = "michael.dedes@sanha.com"

    

    ' Text der E-Mail

    emailBody = "Hallo Michael," & vbCrLf & _

            vbCrLf & _

            "anbei die Rechnungen." & vbCrLf & _

            vbCrLf & _

            "Viele Grüße," & vbCrLf & _

            "Heike" & vbCrLf & _

            "Accountant" & vbCrLf & _

            "T +49 2054 925132" & vbCrLf & _

            vbCrLf & _

            "mailto:heike.ausderfuenten@sanha.com"

    

    ' Pfad zu den Anhängen

    attachmentPath = "D:\Pfad\Zu\Deinem\Anhang\Ordner\"

    

    ' Befehlszeile für Ghostscript

    command = "cmd /c gswin64c -q -dNOPAUSE -sDEVICE=pdfwrite -sOutputFile=""" & savePath & "\" & fileName & "_with_attachments.pdf"" """ & savePath & "\" & fileName & ".pdf"" "

    

    ' Alle PDF-Dateien im Anhangordner durchlaufen und zur Befehlszeile hinzufügen

    Dim attachmentFileName As String

    attachmentFileName = Dir(attachmentPath & "*.pdf") ' Alle PDF-Dateien im Ordner abrufen

    Do While attachmentFileName > "" ' Solange es Dateien gibt

        command = command & """" & attachmentPath & attachmentFileName & """ "

        attachmentFileName = Dir ' Nächste Datei abrufen

    Loop

    

    ' Ghostscript-Befehl ausführen, um PDFs zu kombinieren

    Shell command, vbHide



    ' E-Mail zusammenstellen

    With outlookMail

        .To = emailRecipient

        .Subject = emailSubject

        .Body = emailBody

        

        ' Anhang hinzufügen (die kombinierte PDF-Datei)

        .Attachments.Add savePath & "\" & fileName & "_with_attachments.pdf"

        

        .Display ' E-Mail anzeigen

    End With

    

    Exit Sub ' Bei erfolgreicher Ausführung den Fehlerhandler überspringen



ErrorHandler: ' Fehlerbehandlungsroutine

    MsgBox "Fehler beim Ausführen des Ghostscript-Befehls: " & Err.Description, vbCritical

    Exit Sub

End Sub