Excel Word: mit Excel einen Serienbrief in Word erstellen per vba Code
Aufgabe: in Excel soll per Taste automatisch ein Serienbrief mit den vorhandenen Adressen erstellt werden
Es liegt ein Word-Dokument im gleichen Verzeichnis wie die Excel-Datei.
Die Word-Datei muss schon Seriendruck-Felder haben, die namentlich auf die Überschriften der Spalten in der Excel-Datei basieren, wie zum Beispiel
<<Firma>>, <<Strasse>>, PLZ und Ort ..
Sobald man den Serienbrief Button/Taste gedrückt hat, wird Word automatisch als Master geöffnet und die Serienbriefe als Ausgabe-Datei erstellt
Vba-Code:
Beim Drücken der Taste im Excel-Dokument wird der vba- Code gestartet
Der vba Code öffnet die Serienbrief-Master Datei und bindet die Datentabelle an.
Dann wird eine Ausgabedatei mit den fertigen Adressen erstellt und final der Master wieder geschlossen.
Alles was in Word Serienbriefe betriff, steckt zur Laufzeit in Word.MailMerge.
Das Anbinden der Word-Datei an eine Excel-Quelle wird mit der Word.Methode .MailMerge.OpenDataSource Excelquelle ausgeführt
doc.MailMerge.OpenDataSource Name:=sExcel_Filename, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename
|
Das Word Dokument wird automatisch geöffnet über Word.Documents.Open(Dateiname)
'Dim doc As Object
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)
'</ Word Document oeffnen >
|
Download des Beispiels:
die Dateien liegen im Download, Anhang. Eine Excel Datei mit vba Code und ein Word Serienbrief Master
der gesamte vba-Code der Excel-Datei zum Öffnen der Word-Datei (Master) plus automatisches Anbinden ist hier:
Option Explicit On
Sub fp_Excel_Word_Serienbrief_erstellen()
'----------------------< fp_Excel_Word_Serienbrief_erstellen() >---------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
'< check sende1 >
'*pruefe, ob in der Spalte D ein Eintrag vorhanden ist
Dim intSendezeile As Integer
intSendezeile = 0
Dim intZeile As Integer
For intZeile = 1 To 1000
If ws.Range("D" & intZeile).Value = 1 Then
intSendezeile = intZeile
Exit For
End If
Next
'</ check sende1 >
'< Kontrolle >
If intSendezeile = 0 Then
MsgBox "Es gibt keine Zeile die gesendet werden kann. Alle Zellen in Spalte D sind leer", vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Exit Sub
End If
'</ Kontrolle >
'*diese Funktion oeffnet den Serienbrief BR-Mittelung
Dim sFilename As String
sFilename = ThisWorkbook.Path & "\" & Names("varSerienbrief_Master_Filename").RefersToRange.Value
'< check Document >
Dim fs As New FileSystemObject
If fs.FileExists(sFilename) = False Then
MsgBox "Die Datei existiert nicht" & vbCrLf & "Dateiname:" & sFilename, vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Exit Sub
End If
'</ check Document >
'< Word starten >
Dim wordApp As Object 'As New Word.Application 'Word-dll
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
'</ Word starten >
'< Word Document oeffnen >
'Dim doc As Object
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)
'</ Word Document oeffnen >
Dim wb As Workbook
Set wb = ThisWorkbook
Dim sExcel_Filename As String
sExcel_Filename = ThisWorkbook.FullName
'< Datenquelle einstellen >
'*Datenquelle für den Seriendruck
If wordApp.Build Like "12*" Then
'-< Ist_Office2007 >-
doc.MailMerge.OpenDataSource Name:=sExcel_Filename _
, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Adressen`", SQLStatement1:=" WHERE Anschreiben='1'", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'-</ Ist_Office2007 >-
Else
'-< Ist_Office2010 >-
doc.MailMerge.OpenDataSource Name:=sExcel_Filename, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename
', SQLStatement:="SELECT * FROM 'Adressen$'"
' _
, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Adressen`", SQLStatement1:=" WHERE Anschreiben<>''", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'-</ Ist_Office2010 >-
End If
'</ Datenquelle einstellen >
'< Serienbrief erzeugen >
If Err.Number = 9 Then
'Fehler Maric... Update()
Err.Clear
doc.MailMerge.Execute
ElseIf Err.Number <> 0 Then
MsgBox "Fehler beim Daten holen Word von Excel." & vbCrLf & Err.Description, vbCritical, "fp_Excel_Word_Serienbrief_erstellen()"
Else
doc.MailMerge.Execute
End If
'</ Serienbrief erzeugen >
'< Hauptdocument schliessen >
doc.Close False
'</ Hauptdocument schliessen >
'----------------------< fp_Excel_Word_Serienbrief_erstellen() >---------------------
End Sub
|
als Video Tutorial
|