AW: Aus Excelmakro Word Serienbrief starten
15.12.2008 13:45:22
fcs
Hallo Gerhard,
nach etwas Fummelarbeit rund um die Daten-Verbindung scheint folgendes von Excel aus zu funktionieren.
Bitte nicht vergessen im Excel-VBA-Editor für die datei mit dem Makro den Verweis auf die Microsoft Word X.Y Object Libray zu aktivieren.
Wie weit du dann bei der Serienbrieferstellung das Makro laufen läßt muss du halt selber sehen.
Gruß
Franz
Private Const strDatenQuelle As String = "C:\Lokale Daten\Serienbrief.xls"
'Private Const strDatenQuelle As String = "D:\Time Serienbrief.xls"
Private Const strWOrdvorlage As String = "C:\Lokale Daten\Test\Vorlage.doc"
'Private Const strWOrdvorlage As String = "D:\Vorlage.doc"
Sub Serienbrief()
Dim Bereich As Range, wb As Workbook
z = Cells(Rows.Count, 3).End(xlUp).Row
Set Bereich = Range("A1: AI" & z & "") 'Bereich mit Serienbrief-Daten
Set wb = Workbooks.Open(Filename:=strDatenQuelle)
' Workbooks.Open Filename:= _
"D:\Time Serienbrief.xls"
'Altdatenlöschen
Cells.ClearContents
'neue Daten reinkopieren
Bereich.Copy Destination:=Cells(1, 1)
'Datei Speichern und schliessen
wb.Save
wb.Close
Call Serienb
End Sub
Sub Serienb()
'Im Excel VBA-Editor für die Datei mit diesem Makro unter Extras-Verweise _
den Verweis auf die Microsoft Word x.y Object Library aktivieren!!
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, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:="", _
Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" _
& "User ID=Admin;" _
& "Data Source=" & strDatenQuelle & ";" _
& "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";" _
& "Jet OLEDB:System database="""";" & "Jet OLEDB:Registry Path="""";" _
& "Jet OLEDB:Database Password="""";" _
& "Jet OLEDB:Engine ", _
SQLStatement:="SELECT * FROM `Tabelle1$`", SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
'Serienbrief mit allen Daten in neuem 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-Speicehrn") = 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