Thunderbird-Workshop - Teil 1 - Dateien anhängen

Dieser Teil baut auf "Thunderbird-Workshop - Grundlagen" auf.

In diesem Beispiel wollen wir die aktuelle Datei als Email anhängen.

Public Sub SendActiveWorkbookWithTunderbird()

Rem Aktive Datei speichern
ActiveWorkbook.Save

Rem Inhalt der Email zusammenstellen. Aktive Datei wird angehängt
With NeueThunderbirdEMail
     .EmailFormat = 1
     .SendenVonKonto = 2
     .Empfaenger = "empfaenger@example.com"
     .Betreff = "Test"
     .EMailText = "Hallo!<br><br>Nur ein Test.<br><br>Gruß,<br>Max"
     .Anhang = ActiveWorkbook.FullName
End With

Call CreateThunderbirdEmailObject
End Sub

In diesem Beispiel wollen wir ein Tabellenblatt als PDF-Datei exportieren und diese PDF-Datei anhängen. Hier wurde eine Wartezeit integriert, damit Thunderbird genügend Zeit hat die PDF-Datei anzuhängen bevor selbige wieder gelöscht wird.

#If Win64 And VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#Else
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Public Sub SendActiveWorkbookAsPDFWithTunderbird()
Dim strPDFFile As String

Rem Pfad und Name für PDF-Datei
strPDFFile = Environ("USERPROFILE") & "\Desktop\" & ThisWorkbook.ActiveSheet.Name & ".pdf"

Rem PDF-Datei erstellen
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDFFile, Quality:=xlQualityStandard, _
                                IncludeDocProperties:=False, IgnorePrintAreas:=True, _
                                OpenAfterPublish:=False

Rem Inhalt der Email zusammenstellen. Aktive Datei wird angehängt
With NeueThunderbirdEMail
     .EmailFormat = 1
     .SendenVonKonto = 2
     .Empfaenger = "empfaenger@example.com"
     .Betreff = "Test"
     .EMailText = "Hallo!<br><br>Nur ein Test.<br><br>Gruß,<br>Max"
     .Anhang = strPDFFile
End With

Rem Email erstellen
Call CreateThunderbirdEmailObject

Rem Warten
Sleep 1000

Rem PDF-Datei löschen
Kill strPDFFile

End Sub

In diesem Beispiel wollen wir einen Zellbereich (A1 bis D4) als PDF-Datei exportieren und diese PDF-Datei anhängen. Hier wurde eine Wartezeit integriert, damit Thunderbird genügend Zeit hat die PDF-Datei anzuhängen bevor selbige wieder gelöscht wird.

#If Win64 And VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#Else
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Public Sub SendRangesAsPDFWithTunderbird()
Dim strPDFFile As String

Rem Pfad und Name für PDF-Datei
strPDFFile = Environ("USERPROFILE") & "\Desktop\" & ThisWorkbook.ActiveSheet.Name & ".pdf"

Rem PDF-Datei erstellen
ActiveSheet.Range("A1:D4").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDFFile, Quality:=xlQualityStandard, _
                                IncludeDocProperties:=False, IgnorePrintAreas:=True, _
                                OpenAfterPublish:=False


Rem Inhalt der Email zusammenstellen. Aktive Datei wird angehängt
With NeueThunderbirdEMail
     .EmailFormat = 1
     .SendenVonKonto = 2
     .Empfaenger = "empfaenger@example.com"
     .Betreff = "Test"
     .EMailText = "Hallo!<br><br>Nur ein Test.<br><br>Gruß,<br>Max"
     .Anhang = strPDFFile
End With

Rem Email erstellen
Call CreateThunderbirdEmailObject

Rem Warten
Sleep 1000

Rem PDF-Datei löschen
Kill strPDFFile

End Sub

In diesem Beispiel wollen wir mehrere Anhänge an mehrere Empfänger senden. Die Emailadressen stehen in Spalte "C", die Anhänge in Spalte "I".

	A	B	C	D	E	F	G	H	I
1	Postition	Empfängername	Empfänger-Email	Betreff	Anrede	Textfeld	Schlußgruß	Unterschrift	Anhänge
2	Firmenleitung	Max	Max@test.de	Beispiel anbei	Hallo!	Beispiel anbei.	Gruß,	Der Chef	D:\Test1.pdf
3	Sekretär	Müller	mueller@test.de						D:\Test2.pdf
4									D:\Test3.pdf

Public Sub NeueThunderbirdEmailErstellenB3()

   Dim strEmpfaenger         As String
   Dim strAnhaenge           As String

   Dim lngAnhangZaehler      As Long
   Dim lngAnzahlEmpfaenger   As Long
   
   ' Anzahl Empfänger ermitteln und in Variable schreiben
      For lngAnzahlEmpfaenger = 2 To Cells(Rows.Count, 3).End(xlUp).Row
          If strEmpfaenger = "" Then
             strEmpfaenger = Range("C" & lngAnzahlEmpfaenger).Value
          Else
             strEmpfaenger = strEmpfaenger & ";" & Range("C" & lngAnzahlEmpfaenger).Value
          End If
      Next lngAnzahlEmpfaenger

  ' Anhänge in Variable schreiben
      For lngAnhangZaehler = 2 To Cells(Rows.Count, 9).End(xlUp).Row
          If strAnhaenge = "" Then
             strAnhaenge = Range("I" & lngAnhangZaehler).Value
          Else
             strAnhaenge = strAnhaenge & ";" & Range("I" & lngAnhangZaehler).Value
          End If
      Next lngAnhangZaehler

  ' Inhalt der Email zusammenstellen
      With NeueThunderbirdEMail
          .EmailFormat = 1
          .SendenVonKonto = 6
          .Empfaenger = strEmpfaenger
          .Betreff = Worksheets("EMail Webmaster").Range("D2").Value
          .EMailText = Range("E2").Value & "<br><br>" & _
                       Range("F2").Value & "<br><br>" & _
                       Range("G2").Value & "<br><br>" & _
                       Range("H2").Value
         .Anhang = strAnhaenge
      End With

      Call CreateThunderbirdEmailObject("C:\Programme\Mozilla Thunderbird\Thunderbird.exe")  ' Pfad für 64-bit-Version
End Sub