AW: Serienbrief aus Excel gelöst offen Brief in Ex
09.12.2018 11:28:37
Peter
Hallo Herbert,
das mit der Variablen habe ich jetzt gelöst:
Option Explicit
Option Private Module 'damit kann man die Prozeduren nicht per Alt+F8 starten
'interne Word-Konstanten in Excel nachbilden
Const wdOpenFormatAuto As Integer = 0
Const wdFormLetters As Integer = 0
Const wdSendToNewDocument As Integer = 0
Const wdSendToPrinter As Integer = 1
Const wdDefaultFirstRecord As Integer = 1
Const wdDefaultLastRecord As Integer = -16
Const wdMergeSubTypeAccess As Integer = 1
Const wdFirstDataSourceRecord As Integer = -6
Const wdFormatPDF As Integer = 17
Const wdPrintAllDocument As Integer = 0
Const wdFormatXMLDocument As Integer = 12
Const wdToggle As Long = 9999998
'hier geht es los!
Sub Start_SB_Abrechnung2()
Dim oWrd As Object, oDoc As Object
Dim wb As Workbook, ws As Worksheet
Dim strSheetName As String, xDocV As String, xSql As String
'variable für Sqlstatment1
Dim strSpalte As String
strSpalte = UF_EMails.TextBox2.Value
On Error Resume Next
'prüfen, ob Word schon aktiv ist
Set oWrd = GetObject(, "Word.Application")
If oWrd Is Nothing Then
'wenn nicht, dann Word erst malö öffnen
Set oWrd = CreateObject("Word.Application")
End If
On Error GoTo 0
If oWrd Is Nothing Then
MsgBox "Auf diesem Rechner ist M$-Word nicht installiert!", vbSystemModal + 16, "Hinweis. _
Exit Sub
End If
'diese Arbeitsmappe
Set wb = ThisWorkbook
'1. Tabellenblatt
Set ws = wb.Worksheets(1)
strSheetName = ws.Name
'Ort der Word-Vorlage Serie3nbrief auf dem Datenträger
'hierin befinden sich die {MergeField ...} und der sonstige Brieftext
Set oDoc = oWrd.Documents.Add(Template:=xDocV, NewTemplate:=False, DocumentType:=0)
oWrd.Visible = True
'aktiviert die Word - Datei und öffnet diese maximal
oWrd.Activate
oWrd.WindowState = wdWindowStateMaximize
'neugeöffnete Datei in Serienbrief-Hauptdokument umwandeln
oDoc.MailMerge.MainDocumentType = wdFormLetters
'Fatenfeld-Auswahl in SQL-Schreibweise
xSql = "SELECT * FROM [Tabelle1$]"
'funktioniert mit 2 Filter Test Variable
oDoc.MailMerge.OpenDataSource Name:=wb.FullName _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & wb.FullName & _
"; Mode=Read;Extended Properties=""Excel 12.0 Macro;HDR=YES;IMEX=1;""" _
, SQLStatement:=xSql, SQLStatement1:="Where (" & strSpalte & "='" & strSpalte & "') and _
`Zusagen`='1'", SubType:=wdMergeSubTypeAccess
'Hinweis
'ab Office 2007 sollte der hier angewendete Treiber benutzt werden
'bei *.xlsm als Datenquelle
'";Extended Properties=""Excel 12.0 Macro; HDR=YES; IMEX=1"""
'bei *.xlsx als Datenquelle
'";Extended Properties=""Excel 12.0 Xml; HDR=YES; IMEX=1"""
'alter Daten-Treiber - Bitte nur bei Zugriff auf *.xls-Dateien (bid Excel 2003) _
benutzen
'"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=user;Data Source=" & wb. _
FullName & "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB" _
', SQLStatement:="SELECT * FROM `2017$`", SQLStatement1:="", SubType:= _
'wdMergeSubTypeAccess
' 'Umschalten auf Datenansicht
' oDoc.MailMerge.ViewMailMergeFieldCodes = wdToggle
'beide Objektvariablen für Word ins Nirvana schicken
Set oDoc = Nothing
Set oWrd = Nothing
'Das fertige Word-SB-Hauptdockument ist noch geöffnet aber nicht gespeichert!
' MsgBox "F e r t i g!", vbSystemModal + 64, "Hinweis...'"
'Achtung!!! Excel darf nicht geschlossen werden, da sonst die Daten in Word fehlen
'Excel-Datei und Excel schliessen
' Call Excel_beenden_mit_Prüfung
End Sub
Nun jedoch zu den Briefen aus Excel.
Das hast Du wunderbar beschrieben - aber ich bin kein Profi.
Hier würde ich schon eine Musterdatei benötigen. Vielleich könntest Du mir eine kleine Datei basteln, vielleicht mit bis zu funf Spalten.
Die Idee hatte ich auch schon aber bisher noch nichts geeignetes gefunden.
Gruss
Peter