Word Serinebriefe aus Excel anstoßen - Fehler!!
15.10.2018 12:29:20
Christian
ich habe ein Serienbrief Makro in meine Tabellen eingebaut. was leider "irgendwie" nicht läuft. Zum einen dauert die Erzeugung des Word Serienbriefes viel zu lange, und zum anderen werden massenweise "leere" Serienbriefe erzeugt, obwohl gar keine Daten vorliegen.
In dem Beispiel müssten es 4 Serienbriefe sein. Word erzeugt aber wesentlich mehr
Ich habe den Word Serienbrief - Makro Master,
und die Excel Arbeitsmappe mal beigefügt.
https://www.herber.de/bbs/user/124624.doc
https://www.herber.de/bbs/user/124625.xlsm
das Script anbei (ist eingebaut als Button in die xlsm.
-------------------------------------------
Option Explicit
Sub fp_Excel_Word_Serienbrief_erstellen()
'-------------------------------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
'
'*pruefe, ob in der Spalte M ein Eintrag vorhanden ist
Dim intSendezeile As Integer
intSendezeile = 0
Dim intZeile As Integer
For intZeile = 2 To 1000
If ws.Range("M" & intZeile).Value = 1 Then
intSendezeile = intZeile
Exit For
End If
Next
' check sende1 >
'
If intSendezeile = 0 Then
MsgBox "Es gibt keine Zeile die gesendet werden kann. Alle Zellen in Spalte J 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
'sFilename = Workbooks("Abrechnungsdaten.xlsm").Worksheets("Basisdaten").Range("B5").Value ' _
angepasst auf definierte Zelle von CR
'
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 >
'
Dim wordApp As Object 'As New Word.Application 'Word-dll
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
' Word starten >
'
'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 für den Seriendruck
If wordApp.Build Like "12*" Then
'--
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 `Datenlieferung_Agenturen`", SQLStatement1:=" WHERE Anschreiben=' _
1'", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'- Ist_Office2007 >-
Else
'--
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 >
'
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 >
'
doc.Close False
' Hauptdocument schliessen >
'-------------------------------------------
End Sub
-------------------------
wenn jemand helfen kann wäre es Super!!!
Viele Grüße
Christian