Hallo zusammen,

nach weiteren 2 Stunden, die leider immer wieder ernüchternde Fehler gebracht haben, hoffe ich nun doch noch einmal auf Unterstützung.

@Mase: die Recorderfunktion ist ggf. hilfreich, wenn man Anwendungen nutzen möchte, die Word per se anbietet. In meinem Fall ist das Mailing mit Anhang aus einer Datenbank aber ja ohne VBA gar nicht darstellbar.

@Ralph: ich habe nun das Mailing in die Serienbrieferstellung eingebettet. Verwende ich bei TO ein statisches Element, dann verschickt er brav nach und nach eine passende Anzahl an Mails. Was mir aber dauerhaft nicht gelingt ist mit der passenden Bezeichnung den Wert aus dem zugehörigen Datenbankfeld als Emailadresse zu verwenden. Für mich unerklärlich, da ja mit .DataSource.DataField("...").Value an den vorherigen Stellen die Werte in den Serienbrief eingebettet werden.

Gleiches gilt für den Anhang. 
Es bleibt also die Frage: Wie kann ich im Code den Wert aus dem passenden Datenbankfeld übergeben?

Ich bin weiterhin dankbar für jeden Tipp.

 

Sub Serienbrief_Mailing()

'Definition der Variablen Serienbrief
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String


'Definition der Variablen für das Mailing

Dim objOLOutlook As Object
    Dim objOLMail As Object
    Dim lngMailNr As Long
    Dim lngZaehler As Long
    Dim strAttachmentPfad1 As String
    Dim strSignature As String
    Dim Pfad1 As String

'Errhorhandler
On Error GoTo ErrorHandling

'Auswahlfenster Pfad - Windows-Fenster zur Pfad-Auswahl wird während Programm-Ausführung eingeblendet
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling


'Unterordner definieren, in welchen die PDF-Dateien gespeichert werden sollen
'=========================================================================
Path = Path & "\ "



On Error GoTo ErrorHandling

'Applikation ausblenden - für bessere Performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorgang kann einige Minuten dauern - Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False

'Erstelle Serienbrief und Export als PDF
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord

'Dateinamen definieren für PDF-Dateien
'============================================================
sBrief = Path & .DataFields("Anreisedatum").Value & "_" & .DataFields("Anreisende_Gäste").Value & ".pdf"

End With

.Execute Pause:=False

If .DataSource.DataFields("Anreisende_Gäste").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False

'Mailversand
'============================================================

Set objOLOutlook = CreateObject("Outlook.Application")

strAttachmentPfad1 = "C:\Users\Kaiser\Desktop\Serienbriefe\Brief\05.12.22_Herr Biyan Abdo.pdf"


   Set objOLMail = objOLOutlook.CreateItem(olMailItem)
                With objOLMail
                    .BodyFormat = olFormatHTML
                    .Display
                End With
                    strSignature = objOLMail.HTMLBody
                With objOLMail
                    .To = "kaiser.webphone@googlemail.com"
                    .CC = ""
                    .BCC = ""
                    .Subject = "Neue Mail"
                    .BodyFormat = olFormatHTML
                    .HTMLBody = "<font face=""calibri"" style=""font-size:11pt;"">" & _
                        "Sehr geehrte Damen und Herren,<br><br>" & _
                        "in der Anlage senden wir Ihnen die Anreiseerinnerung für Ihre:n Auszubildende:n. <br>" & _
                        "Für Rückfragen stehen wir gern zur Verfügung.</font>" & _
                        strSignature
                    .Attachments.Add strAttachmentPfad1
                    .Send
                    '.Display
 
                End With
           
      Set objOLMail = Nothing
               
  Set objOLOutlook = Nothing


If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If

'Nächster Datensatz
Loop

End With


'Errorhandling
ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 5852 Then
MsgBox "Das Dokument ist kein Serienbrief"
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If

End Sub