Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1568to1572
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

Problem Serienbrief

Problem Serienbrief
18.07.2017 14:27:31
Peter
Hallo ihr Excelspezialisten,
ich suche seit Tagen nach einer Lösung.
Aus dem Forumarchiv habe ich einen Code zur Erstellung eines Serienbriefes herunter-
geladen und für meine Bedürfnisse abgeändert.
Den Code füge ich u.a. bei.
Es läuft im Prinzip alles wunderbar, aber ich möchte die Datei speichern unter
Name.docm d. h. es soll die Datei, welche ein Makro enthält anschliessend so
funktionieren, dass das Makro gestartet werden kann.
So wie dies jetzt speichert erfolgt beim Öffnen die Meldung: Leider kann worddatei...
nicht geöffnet werden, da der Inhalt Probleme bereitet.
Das Problem ist, dass das Dokument nicht richtig gespeichert wird.
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
Const wdFormatXMLDocumentMacroEnabled As Integer = 0
Const wdWindowStateMinimize As Integer = 0
Const wdWindowStateMaximize As Integer = 0
'hier geht es los!
Sub Serienbrief_erstellen()
Dim oWrd As Object, oDoc As Object
Dim wb As Workbook, ws As Worksheet
Dim strSheetName As String, xDocV As String, xSql As String
'Auswahldokument speichern
Dim Pfad, Datei
Pfad = "C:\Users\Peter\Desktop\Test_2017_07_17\"
Debug.Print Pfad
Datei = "NTest1Datum1.docm"
Debug.Print Datei
'Serienbrief speichern
Dim PfadS, DateiS
PfadS = "C:\Users\Peter\Desktop\Test_2017_07_17\"
Debug.Print PfadS
DateiS = "Serienbrief_2017_07_17"
Debug.Print DateiS
'für Vorlagedatei wieder schliessen
Dim AuswDok As String
Dim objdoc As Object
AuswDok = "Serienbrief_2017_07_17.docm"
Debug.Print AuswDok
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
'2. Tabellenblatt
Set ws = wb.Worksheets("Tabelle1")
strSheetName = ws.Name
'Ort der Word-Vorlage Serienbrief auf dem Datenträger
'hier wird davon ausgegangen, das sich Word- & Exceldatei im gleichen Verzeichnis befinden
xDocV = wb.Path & "\" & "VorlageTest_.docm"
Debug.Print xDocV
'hierin befinden sich die {MergeField ...} und der sonstige Brieftext
Set oDoc = oWrd.Documents.Add(Template:=xDocV, NewTemplate:=False, DocumentType:=0)
oWrd.Visible = True
With oDoc
'neugeöffnete Datei in Serienbrief-Hauptdokument umwandeln
.MailMerge.MainDocumentType = wdFormLetters
'Datenfeld-Auswahl in SQL-Schreibweise
xSql = "SELECT * FROM [Tabelle1$]"
.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:="", 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
'Filter setzen
.MailMerge.DataSource.QueryString = _
"SELECT * FROM `Tabelle1$`  WHERE `Name` > 0  And `Vorname` > 0 "
'Umschalten auf Datenansicht
.MailMerge.ViewMailMergeFieldCodes = wdToggle
End With
' With oWrd.Dialogs(84) 'wdDialogFileSaveAs
'    .Name = Pfad & Datei
'    .Show
'  End With
'neue Datei speichern unter
oDoc.Application.WindowState = wdWindowStateMinimize
oDoc.SaveAs Pfad & Datei
oDoc.SaveAs2 Filename:="NTest1Datum1.docm", FileFormat:= _
wdFormatXMLDocumentMacroEnabled, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
oDoc.Application.WindowState = wdWindowStateMaximize
oDoc.Close
oWrd.Documents.Open ("C:\Users\Peter\Desktop\Test_2017_07_17\NTest1Datum1.docm")
Set oDoc = oWrd.Documents.Open("C:\Users\Peter\Desktop\Test_2017_07_17\NTest1Datum1.docm") ' _
Dokument öffnen
oWrd.Application.Run "oDoc!Projekt.NewMacros.Sendkey"
''speichern mit Abfrage
'    oDoc.Application.WindowState = wdWindowStateMinimize
'''    If MsgBox("Auswahldokument speichern ?", vbYesNo + vbQuestion, _
'''        "Serienbrief-Erstellung speichern") = vbYes Then
'''        oDoc.Application.WindowState = wdWindowStateMaximize
''''        oDoc.Application.Dialogs(wdDialogFileSaveAs).Show
'''        oDoc.SaveAs Pfad & Datei
'''    End If
'    oDoc.Application.WindowState = wdWindowStateMaximize
'  End With
'speichern ohne Abfrage
'    oDoc.Application.WindowState = wdWindowStateMinimize
'''    oDoc.Application.Dialogs(wdDialogFileSaveAs).Show
'    oDoc.SaveAs Pfad & Datei
'    oDoc.Application.WindowState = wdWindowStateMaximize
''''''hier Datumprüfung einfügen
'''''Dim dia As Date
'''''   Dim dia2A As Range
'''''   Dim dia2E As Range
''''''   dia = Date
''''''    dia = Range("C8")
''''''   Set dia2A = Range("C10")  ' in A1 steht z.B. 01.10. 2008
''''''   Set dia2E = Range("C12")
'''''    dia = Range("W18") 'nur zum test sonst W15
'''''   Set dia2A = Range("W25")  ' in A1 steht z.B. 01.10. 2008
'''''   Set dia2E = Range("W29")
''''''   If dia >= dia2A Then
''''''   MsgBox "> grösser"
''''''   Else
''''''   MsgBox "= dia2A And dia  1 Then
''''''''''objdoc.Close Savechanges:=False
''''''''''Else
''''''''''Word.Application.Quit
''''''''''    End If
''''''''''End If
'''''''''Serienbrief speichern
''''''''    Dim wdApp As Object, wdDoc As Object
''''''''    Set wdApp = GetObject(, "Word.Application")
''''''''    Set wdDoc = wdApp.Documents(1)
''''''''    wdDoc.SaveAs PfadS & DateiS
''''''Excel in Vordergrund bringen
'''''AppActivate Application.Caption
''''''Beginn MsgBox - Druckauswahl
'''''    Dim iRet As Integer
'''''    Dim strPrompt As String
'''''    Dim strTitle As String
'''''    ' Promt
'''''    strPrompt = "Ja - Button                 = alles Drucken" & vbLf & _
'''''      "Nein - Button            = Drucken-Voransicht" & vbLf & _
'''''      "Abbrechen - Button = Serienbrief Selbstauswahl"
'''''    ' Dialog's Title
'''''    strTitle = "Druckauswahl"
'''''    'Display MessageBox
'''''    iRet = MsgBox(strPrompt, vbYesNoCancel, strTitle)
'''''    wdDoc.Application.WindowState = wdWindowStateMinimize
'''''   If iRet = vbYes Then
''''''      MsgBox "alles Drucken"
'''''      wdDoc.Application.WindowState = wdWindowStateMaximize
'''''      wdDoc.PrintOut
'''''   ElseIf iRet = vbNo Then
''''''      MsgBox "Drucken-Voransicht"
'''''      wdDoc.Application.WindowState = wdWindowStateMaximize
'''''      wdDoc.PrintPreview
'''''   ElseIf iRet = vbCancel Then
'''''      MsgBox "Serienbrief Selbstauswahl"
'''''      wdDoc.Application.WindowState = wdWindowStateMaximize
''''''      Exit Sub
'''''   End If
''''''ende msgbox - Druckauswahl
'''''   Else
'''''   MsgBox "Datum liegt ausserhalb"
''''''   Exit Sub
'''''    oWrd.Activate
''''''    oDoc.Application.WindowState = wdWindowStateMaximize
'''''   End If
'beide Objektvariablen für Word ins Nirvana schicken
Set oDoc = Nothing
Set oWrd = Nothing
'    Set docSerienbrief = Nothing
Set objdoc = Nothing
'    Set AuswDok = Nothing
'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

Bei dieser Zeile: 'neue Datei speichern unter beginnt das Problem!
Wie kann die Datei gespeichert werden, damit das ganze richtig funktioniert?
Datei anbei:https://www.herber.de/bbs/user/114937.xlsm
Worddatei konnte nicht beigefügt werden da *.docm
Besten Dank für eure Hilfe.
Gruss
Peter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem Serienbrief
18.07.2017 16:25:59
Oberschlumpf
Hi Peter
Die Word-Datei kannst du vorher mit 7Zip in eine Archiv-Datei speichern.
Diese daraus resultierende ZIP-Datei ist hier erlaubt für den Upload von dir.
Ciao
Thorsten
AW: Problem Serienbrief
18.07.2017 18:59:58
Peter
Hallo Thorsten,
danke für den Hinweis.
Datei anbei:https://www.herber.de/bbs/user/114943.zip
Gruss
Peter
AW: Problem Serienbrief
18.07.2017 23:31:50
Luschi
Hallo Peter,
der Wert für 'wdFormatXMLDocumentMacroEnabled' ist falsch deklariert, siehe:
Userbild
Gruß von Luschi
aus klein-Paris
AW: Problem Serienbrief
19.07.2017 08:00:31
Peter
Hallo Luschi,
danke für Deine Hilfe.
Das Problem bleibt jedoch bestehen. Die Datei wird gespeichert, aber nicht als Kopie von der Serienbrief-vorlage. Es wird als Dokument mit Makros gespeichert ein Öffnen ist jedoch nicht möglich. Jetzt Fehler:
Datentypenkonflikt in Kriterienausdruck.
Was kann ich machen, dass es als Kopie des Serienbriefes gespeichert wird?
Danke für Deine Hilfe.
Gruss
Peter
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige