abuelito
Goto Top

VBA Excel Makro - Serienbrief in Word aus Excel starten und anschließend einzeln speichern

Hallo an Alle,

ich möchte gerne aus Excel heraus mein Serienbrief starten und die Briefe einzeln speichern. Das bedeutet, ich benötige jeden einzeln ausgedruckten Brief 1x als .docx und als .pdf .. der Dateiname muss dabei folgendermaßen lauten:

yymmdd_Vorname_Nachname_Test.docx bzw. .pdf

Ich hoffe ihr könnt mir helfen.

Vielen Dank
Grüße

Anbei mein bisheriger Code, der funktioniert, aber leider weiß ich nicht, wie ich den umbauen muss, damit ich im letzten Schritt alle Briefe einzeln speichern kann:

Private Const strDatenQuelle As String = "C:\Test\Serienbrief\Datenquellen\Test_Beispiel_Serienbrief.xlsx"  
Private Const strWordVorlage As String = "C:\Test\Serienbrief\SerienbriefBeispiel Test_Vorlage_IR.docx"  

Sub Serienbrief()
    
    Dim Bereich As Range
    Dim wb As Workbook, wbAlle As Workbook
    
    Application.ScreenUpdating = False
    
    ' Datei mit allen Daten, auch ältere Daten wird geöffnet  
    Set wbAlle = Workbooks.Open(Filename:="C:\Test\Serienbrief\Datenquellen\Test_Beispiel_" & Format(Date, "yyyy_mm_dd") & ".xlsx")  
    
    Set Bereich = Range("A1:BH65536")                           ' Bereich mit Serienbrief-Daten  
    Set wb = Workbooks.Open(Filename:=strDatenQuelle)           ' Datei bzw. Datenquelle mit aktuellen Daten für den Serienbrief  

    ' Altdaten aus der Datenquelle für den Serienbrief löschen  
    
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select  
    
    'neue Daten reinkopieren  
    
    Bereich.Copy Destination:=Cells(1, 1)
    
    'Dateien Speichern bzw. schliessen  
    
    wb.Save
    wb.Close
    wbAlle.Close
        
    Application.ScreenUpdating = True
    
    Call Serienb

End Sub

Sub Serienb()
  
  ' Im Excel VBA-Editor muss vorher für die Datei mit diesem Makro unter Extras-Verweise  
  ' den Verweis auf die Microsoft Word x.y Object Library aktiviert werden!!  
  
  Dim WinWord, WinDoc As Word.Document, docSerienbrief As Word.Document
  Dim sFile As String, strCon As String
    
  sFile = strWordVorlage
  
  Set WinWord = CreateObject("Word.Application")  
  
  With WinWord
        .Visible = True
    
    '   Vorlagedatei öffnen  
    
    Set WinDoc = .Documents.Open(sFile)
    
    With WinDoc
      
      With .MailMerge
    
    '   Datenquelle öffnen  
        
        .OpenDataSource Name:=strDatenQuelle, _
          ConfirmConversions:=False, _
          LinkToSource:=True, _
          Revert:=False, _
          Format:=wdOpenFormatAuto, _
          Connection:="Provider=Microsoft.Jet.OLEDB.4.0;" _  
            & "User ID=Admin;" _  
            & "Data Source=" & strDatenQuelle & ";" _  
            & "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";" _  
            & "Jet OLEDB:System database="""";" & "Jet OLEDB:Registry Path="""";" _  
            & "Jet OLEDB:Engine ", _  
          SQLStatement:="SELECT * FROM `Tabelle1$`", SQLStatement1:="", _  
          SubType:=wdMergeSubTypeAccess
    
    '   Serienbrief mit allen Daten im neuen Dokument erstellen  
        
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
          .FirstRecord = wdDefaultFirstRecord
          .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
        Set docSerienbrief = WinWord.ActiveDocument

    '   Datenquelle wieder schliessen  
        
        .DataSource.Close
      End With

    '   Vorlagedatei wieder schliessen  
      
      .Close Savechanges:=False
    End With

    '   Serienbrief - Drucken - Seitenvorschau  
    
    docSerienbrief.Application.WindowState = wdWindowStateMinimize
    If MsgBox("Serienbrief Drucken ?", vbYesNo + vbQuestion, _  
        "Serienbrief-Erstellung - Drucken - Seitenvorschau") = vbYes Then  
        docSerienbrief.Application.WindowState = wdWindowStateMaximize
        docSerienbrief.PrintPreview
    '   docSerienbrief.PrintOut  
    End If

    '   Serienbrief - Speichern  
    
    docSerienbrief.Application.WindowState = wdWindowStateMinimize
    If MsgBox("Serienbrief Speichern ?", vbYesNo + vbQuestion, _  
        "Serienbrief-Erstellung-Speichern") = vbYes Then  
        docSerienbrief.Application.WindowState = wdWindowStateMaximize
        docSerienbrief.Application.Dialogs(wdDialogFileSaveAs).Show
    End If
    
    docSerienbrief.Application.WindowState = wdWindowStateMaximize
 
 End With
          
  Set docSerienbrief = Nothing
  Set WinWord = Nothing
  Set WinDoc = Nothing
  
End Sub

Content-Key: 342756

Url: https://administrator.de/contentid/342756

Ausgedruckt am: 19.03.2024 um 11:03 Uhr

Mitglied: colinardo
Lösung colinardo 07.07.2017, aktualisiert am 24.01.2024 um 18:01:39 Uhr
Goto Top
Servus @abuelito,
hier hast du ein VBA-Beispiel dazu aus Word.
Die Vorgehensweise ist folgende: Mit einer For-Schleife werden alle Records nacheinander ausgeführt, das dabei generierte Dokument als DOCX und PDF gespeichert, geschlossen und dann der nächste Datensatz verarbeitet.
Weitere Kommentare findest du zu den Zeilen im Code.
Denke du solltest es auf deinen Anwendungsfall in Excel jetzt selbst ummünzen können face-wink.
Sub MailMergeSaveAsSingleDocs()
    Dim strDatenquelle As String, i as Long, strFilenameDOCX as String, strFilenamePDF as String
    ' Ausgabepfad  
    Const OUTPUTPATH = "D:\Daten\output"  
    ' Datenquelle  
    strDatenquelle = "D:\Daten\datenquelle.xlsx"  
    'Screenupdating deaktivieren  
    Application.ScreenUpdating = False
    With ThisDocument.MailMerge
        ' Dokumenttyp festlegen  
        .MainDocumentType = wdFormLetters
        ' Datenquelle öffnen (den genutzten Tabellenname "Tabelle1" bitte anpassen sollte das Arbeitsblatt anders heißen, das Dollarzeichen und  die Backticks müssen aber erhalten bleiben, nur wenn man einen benannten Bereich nutzen möchte kann das Dollarzeichen entfallen)  
        .OpenDataSource Name:=strDatenquelle, Format:=wdOpenFormatAuto, SQLStatement:="SELECT * FROM `Tabelle1$`", ReadOnly:=True  
        'Datensätze sollen in neuen Dokumenten laden  
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        'Führe folgende Aktionen für jeden Datensatz der Datenquelle durch.  
        For i = 1 To .DataSource.RecordCount
            ' Datenquelle auf aktuellen Datensatz beschränken  
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                ' Dateinamen für DOCX und PDF zusammenbauen  
                strFilenameDOCX = Format(Date, "yyyyMMdd") & "_" & .DataFields("Vorname").Value & "_" & .DataFields("Nachname").Value & "_Test.docx"  
                strFilenamePDF = Format(Date, "yyyyMMdd") & "_" & .DataFields("Vorname").Value & "_" & .DataFields("Nachname").Value & "_Test.pdf"  
            End With
            ' Mailmerge für aktuellen Datensatz ausführen  
            .Execute Pause:=False
            ' Dokument des aktuellen Datensatzes  
            With ActiveDocument
                ' Speichern als DOCX  
                .SaveAs2 OUTPUTPATH & "\" & strFilenameDOCX  
                ' Speichern als PDF  
                .ExportAsFixedFormat OUTPUTPATH & "\" & strFilenamePDF, wdExportFormatPDF  
                ' Dokument schließen  
                .Close False
            End With
        Next
        ' Datenquelle schließen  
        .DataSource.Close
    End With
    ' Screenupdating aktivieren  
    Application.ScreenUpdating = True
End Sub

Wünsche dir viel Erfolg.
Grüße Uwe
Mitglied: abuelito
abuelito 08.07.2017 um 11:55:13 Uhr
Goto Top
Hallo Uwe,

vielen lieben Dank für Deine Hilfe.

Habe Dein Programm-Code bei mir eingefügt, aber ich bekomme eine Fehlermeldung face-sad und komme einfach nicht weiter .. sitze jetzt schon seit heute Morgen um 7 Uhr dran face-sad

Hoffe Du kannst mir helfen

Vielen Dank
Grüße

Anbei mein veränderter Programm-Code (inkl. Deines, was ich an meins etwas angepasst habe):

Private Const strDatenquelle As String = "C:\Test\Serienbrief\Datenquellen\Test_Beispiel_Serienbrief.xlsx"  
Private Const strWordVorlage As String = "C:\Test\Serienbrief\SerienbriefBeispiel Test_Vorlage_IR.docx"  

Sub Serienbrief()
    
    Dim Bereich As Range
    Dim wb As Workbook, wbAlle As Workbook
    
    Application.ScreenUpdating = False
    
    ' Datei mit allen Daten, auch ältere Daten wird geöffnet  
    Set wbAlle = Workbooks.Open(Filename:="C:\Test\Serienbrief\Datenquellen\Test_Beispiel_" & Format(Date, "yyyy_mm_dd") & ".xlsx")  
    
    Set Bereich = Range("A1:BH65536")                           ' Bereich mit Serienbrief-Daten  
    Set wb = Workbooks.Open(Filename:=strDatenquelle)           ' Datei bzw. Datenquelle mit aktuellen Daten für den Serienbrief  

    ' Altdaten aus der Datenquelle für den Serienbrief löschen  
    
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select  
    
    'neue Daten reinkopieren  
    
    Bereich.Copy Destination:=Cells(1, 1)
    
    'Dateien Speichern bzw. schliessen  
    
    wb.Save
    wb.Close
    wbAlle.Close
        
    Application.ScreenUpdating = True
    
    Call Serienb

End Sub

Sub Serienb()
  
  ' Im Excel VBA-Editor muss vorher für die Datei mit diesem Makro unter Extras-Verweise  
  ' den Verweis auf die Microsoft Word x.y Object Library aktiviert werden!!  
  
  Dim WinWord, WinDoc As Word.Document, docSerienbrief As Word.Document
  Dim sFile As String, strCon As String
      
  sFile = strWordVorlage
  
  Set WinWord = CreateObject("Word.Application")  
  
  With WinWord
        .Visible = True
    
    '   Vorlagedatei öffnen  
    
    Set WinDoc = .Documents.Open(sFile)
    
    With WinDoc
      
      With .MailMerge
    
    '   Datenquelle öffnen  
        
        .OpenDataSource Name:=strDatenquelle, _
          ConfirmConversions:=False, _
          LinkToSource:=True, _
          Revert:=False, _
          Format:=wdOpenFormatAuto, _
          Connection:="Provider=Microsoft.Jet.OLEDB.4.0;" _  
            & "User ID=Admin;" _  
            & "Data Source=" & strDatenquelle & ";" _  
            & "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";" _  
            & "Jet OLEDB:System database="""";" & "Jet OLEDB:Registry Path="""";" _  
            & "Jet OLEDB:Engine ", _  
          SQLStatement:="SELECT * FROM `Tabelle1$`", SQLStatement1:="", _  
          SubType:=wdMergeSubTypeAccess
    
    '   Serienbrief mit allen Daten im neuen Dokument erstellen  
        
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
          .FirstRecord = wdDefaultFirstRecord
          .LastRecord = wdDefaultLastRecord
        End With
           
        .Execute Pause:=False
        Set docSerienbrief = WinWord.ActiveDocument

    '   Datenquelle wieder schliessen  
        
        .DataSource.Close
      End With

    '   Vorlagedatei wieder schliessen  
      
      .Close Savechanges:=False
    End With

    '   Serienbrief - Drucken - Seitenvorschau  
    
    docSerienbrief.Application.WindowState = wdWindowStateMinimize
    If MsgBox("Alle Briefe aus dem Serienbrief Drucken?", vbYesNo + vbQuestion, _  
        "Serienbrief-Erstellung - Drucken - Seitenvorschau") = vbYes Then  
        docSerienbrief.Application.WindowState = wdWindowStateMaximize
        docSerienbrief.PrintPreview
    '   docSerienbrief.PrintOut  
    End If

    '   Serienbrief - Speichern  
    
    docSerienbrief.Application.WindowState = wdWindowStateMinimize
    If MsgBox("Serienbrief als Gesamtdokument Speichern?", vbYesNo + vbQuestion, _  
        "Serienbrief-Erstellung-Speichern") = vbYes Then  
        docSerienbrief.Application.WindowState = wdWindowStateMaximize
        docSerienbrief.SaveAs Filename:="C:\Test\Serienbrief\Druck\Test_Beispiel_Alle_" & Format(Date, "yyyy_mm_dd") & ".docx"  
        'docSerienbrief.Application.Dialogs(wdDialogFileSaveAs).Show  
    End If
    docSerienbrief.Application.WindowState = wdWindowStateMaximize
    
  docSerienbrief.Close
    
  End With
      
  Set docSerienbrief = Nothing
  Set WinWord = Nothing
  Set WinDoc = Nothing

  Call SerienbSaveAsSingleDocs

End Sub

Sub SerienbSaveAsSingleDocs()

    Dim strDatenquelle As String, strFilenameDOCX As String, strFilenamePDF As String, sFile As String
    Dim i As Long
    Dim WinWord, WinDoc As Word.Document

    sFile = strWordVorlage
    
    Set WinWord = CreateObject("Word.Application")  
    
    ' Ausgabepfad  

    Const OUTPUTPATH = "C:\Test\Serienbrief\Druck"  

    ' Datenquelle  

    'strDatenquelle = "D:\Daten\datenquelle.xlsx"  

    ' Screenupdating deaktivieren  

    Application.ScreenUpdating = False

    Set WinDoc = WinWord.Documents.Open(sFile)

    With WinDoc.MailMerge

        'Dokumenttyp festlegen  

        .MainDocumentType = wdFormLetters

        'Datenquelle öffnen  

        .OpenDataSource Name:=strDatenquelle, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & strDatenquelle & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OL", SQLStatement:="SELECT * FROM `Tabelle1$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess  

        'Datensätze sollen in neuen Dokumenten laden  

        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True

        'Führe folgende Aktionen für jeden Datensatz der Datenquelle durch.  

        For i = 1 To .DataSource.RecordCount

            'Datenquelle auf aktuellen Datensatz beschränken  

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

                'Dateinamen für DOCX und PDF zusammenbauen  

                strFilenameDOCX = Format(Date, "yyyyMMdd") & "_" & .DataFields("Vorname1").Value & "_" & .DataFields("Nachname").Value & "_Test.docx"  
                strFilenamePDF = Format(Date, "yyyyMMdd") & "_" & .DataFields("Vorname1").Value & "_" & .DataFields("Nachname").Value & "_Test.pdf"  
            End With

            'Mailmerge für aktuellen Datensatz ausführen  

            .Execute Pause:=False

            ' Dokument des aktuellen Datensatzes  

            With ActiveDocument

                ' Speichern als DOCX  

                .SaveAs2 OUTPUTPATH & "\" & strFilenameDOCX  

                'Speichern als PDF  

                .ExportAsFixedFormat OUTPUTPATH & "\" & strFilenamePDF, wdExportFormatPDF  

                'Dokument schließen  

                .Close False
            End With
        Next
    End With

    'Screenupdating aktivieren  

    Application.ScreenUpdating = True

End Sub
fehler_ole
Mitglied: abuelito
abuelito 10.07.2017 um 11:24:19 Uhr
Goto Top
Hallo Uwe,

ich hab es geschafft face-smile

Vielen Dank für Deine Hilfe, Danke, Danke face-smile

Grüße
Mitglied: colinardo
colinardo 10.07.2017 aktualisiert um 17:04:32 Uhr
Goto Top
Zitat von @abuelito:

Hallo Uwe,

ich hab es geschafft face-smile
Freut mich face-smile.
Sorry das ich dir leider nicht zeitnah antworten konnte, ich musste unerwartet übers Wochenende auf einen Einsatz ins Ausland.

Grüße Uwe
Mitglied: abuelito
abuelito 11.07.2017 um 08:52:10 Uhr
Goto Top
Hallo Uwe,

alles gut, schließlich hat mir Dein Programmcode ja geholfen .

Danke
Mitglied: lwis94
lwis94 20.01.2024 um 10:32:35 Uhr
Goto Top
Guten Tag zusammen,
der letzte Beitrag ist nun schon ein paar Jahre her, allerdings beschäftige ich mich auch nun auch mit dem Thema.

Mein Problem ist, dass ich für die folgende Zeile aus colinardos Code den Laufzeitfehler 9105 bekomme:
.OpenDataSource Name:=strDatenquelle, Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & strDatenquelle & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OL", SQLStatement:="SELECT * FROM `Tabelle1$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess  

Die Fehlerbeschreibung besagt, dass die Zeichenfolge länger als 255 Zeichen ist, was den Fehler auslöst.
Allein der Teil vom Code hat schon 429 Zeichen.
Hinzukommen noch 135 für den Pfad zur Datenquelle.
In anderen Threads zu dem Laufzeitfehler habe ich gelesen, dass gewisse Parameter ausgelassen würde. Ich kenne mich damit aber zu wenig aus, um das vorzunehmen. Ich wäre auch sehr dankbar über eine Erklärung zu dem Code.


Falls sich jemand fragt, was ich erreichen will:
Mein Plan ist eine Batch-Datei, die ein Word-Serienbriefdokument mit Makros triggert, der den fertigen Serienbrief als PDF auf einem Netzlaufwerk speichert. Was auch schon halbwegs funktioniert.
Da meine Kollegen es steuern sollen, möchte ich es so einfach wie möglich gestalten.

Für den Aufruf nutze ich eine angepasste Version hiervon:
C:\Program Files (x86)\Microsoft Office\root\Office16\WINWORD.EXE" w:\temp\Testdoc.docm /mTest   
welcher mit verknüpfter Datenquelle funktioniert. Word öffnet sich, Makro wird ausgeführt, PDF auf dem Netzlaufwerk gespeichert und Word wieder geschlossen.
Allerdings wird der Name bzw. ein gewisser Teil des Namens der Datenquelle höchstwahrscheinlich variieren, weswegen ich die Datenquelle gerne im Code verankern würde. Mir schwebte etwas wie "\Pfad\zur\Datenquelle*.xlsx" vor.

Ich bin aber auch nicht abgeneigt einem anderen Ansatz zu folgen, falls jemandem etwas einfällt.


Jedenfalls schon einmal vielen dank im Voraus.

LWis94
Mitglied: colinardo
colinardo 24.01.2024 aktualisiert um 18:02:17 Uhr
Goto Top
Servus @lwis94, willkommen auf Administrator.de!
Der Beitrag ist ja schon etwas älter, die Zeile kannst du mittlerweile auf folgendes Konstrukt reduzieren dann solltest du auch keine Probleme mehr mit dem Zeichenlimit von 255 für den Connection-String bekommen
.OpenDataSource Name:=strDatenquelle, Format:=wdOpenFormatAuto, SQLStatement:="SELECT * FROM `Tabelle1$`", ReadOnly:=True, LinkToSource:=False  
Habe das auch oben nachgetragen.

Grüße Uwe