Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1648to1652
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Word Serinebriefe aus Excel anstoßen - Fehler!!

Word Serinebriefe aus Excel anstoßen - Fehler!!
15.10.2018 12:29:20
Christian
Hallo Freunde,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Word Serinebriefe aus Excel anstoßen - Fehler!!
17.10.2018 13:56:56
fcs
Hallo Christian,
das Problem ist, dass die UsedRange (verwendeter Bereich) durch die Formatierungen bis Zeile 4000 geht. Dadurch liest Word soviele leere Datensätze ein.
Ich würde hier die relevanten Daten per Autofilter (Spalte M = 1) filtern und dann in eine separate Datei kopieren und in Word diese Datei als Quelle setzen.
Ich hab das Makro mal in diese Richtung angepasst und für Excel 2010 auch die Anweisung erweitert, so das nicht mehr nach dem Namen der Tabelle mit den Daten gefragt wird.
LG
Franz
Sub fp_Excel_Word_Serienbrief_erstellen()
'-------------------------------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
Dim sMsgTitel As String
sMsgTitel = "fp_Excel_Word_Serienbrief_erstellen()"
'
'*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, sMsgTitel
Exit Sub
End If
' Kontrolle >
'
Dim sExcel_Filename As String
Dim wbData As Workbook
Dim Zeile_L As Long
With ws
'letzte Zeile mit Daten
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'Autofilter ggf. deaktivieren
If .AutoFilterMode = True Then
If .FilterMode = True Then
.ShowAllData
End If
.AutoFilterMode = False
End If
'Autofilter setzen fpr Spalten A bis M mit Filterwert für Spalte J = 1
.Range(.Cells(1, 1), .Cells(Zeile_L, 13)).AutoFilter Field:=13, Criteria1:=1
End With
'neue Arbeitsmappe anlegen
sExcel_Filename = ThisWorkbook.Path & "\" & "Serienbrief_Data.xlsx"
Set wbData = Application.Workbooks.Add(Template:=xlWBATWorksheet)
wbData.Worksheets(1).Name = "Datenlieferung_Agenturen"
'gefilterte Daten kopieren und Spaltenbreite autmatisch anpassen
ws.AutoFilter.Range.Copy wbData.Worksheets(1).Cells(1, 1)
wbData.Worksheets(1).Columns.AutoFit
'temporäre Datei speichern und schliessen
Application.DisplayAlerts = False
wbData.SaveAs Filename:=sExcel_Filename, FileFormat:=51, addtomru:=False
wbData.Close savechanges:=False
Set wbData = Nothing
Application.DisplayAlerts = True
'im Blatt alle Daten wieder anzeigen.
ws.ShowAllData
' Serienbriefdaten in temporäre Datei übertragen >
'
'*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, sMsgTitel
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
'
'*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
doc.MailMerge.OpenDataSource Name:=sExcel_Filename, ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, _
Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & sExcel_Filename _
& ";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;Je", _
SQLStatement:="SELECT * FROM `Datenlieferung_Agenturen$`", SQLStatement1:="", _
SubType:=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, sMsgTitel
Else
doc.MailMerge.Execute
End If
' Serienbrief erzeugen >
'
doc.Close False
' Hauptdocument schliessen >
'
If Dir(sExcel_Filename)  "" Then VBA.Kill sExcel_Filename
' temporäre Datei mit Serienbrief-Daten wieder löschen>
'-------------------------------------------
End Sub

Anzeige
AW: Word Serinebriefe aus Excel anstoßen - Fehler!!
19.10.2018 12:21:13
Christian
Hallo Franz,
Richtig Cool!!!
Hab bei dem einen Thema jetzt die Formatierung nur auf die richtige Zeile angepasst, so das nicht mehr die ganze Spalte formatiert wird und dann lief es auch mit Word.
Aber das jetzt die Abfrage nach der Datenquelle weg ist, ist richtig klasse.!!
Danke dafür:
PS:
Machst du das ganze mit VBA beruflich?
Wir sind/waren auf der Suche nach jemanden, der uns In Excel und Word VBA Lösungen programmiert. Das ganze aber nur auf selbständiger Basis, Projektbezogen. Ob da jetzt schon jemand gefunden wurde, weiß ich gar nicht.
AW: Word Serinebriefe aus Excel anstoßen - Fehler!!
19.10.2018 13:03:48
fcs
Hallo Christian,
Machst du das ganze mit VBA beruflich?

Nein, beruflich arbeite ich als Ingenieur im Bereich Verfahrenstechnik.
VBA ist meistens Freizeitvergnügen mit Schwerpunkt Excel - und das seit über 20 Jahren.
Gelegentlich hab ich auch schon größere Projekte programmiert, aber nur ohne großen Termindruck.
Das könnte sich in 2 bis 3 Jahren ändern, wenn ich Renter eine Nebenbeschäfftigung brauche.
LG
Franz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige