Problem beim Öffnen word aus Excel

Sub Makro1_Empfänger_auswählen1() Dim MyPfad As String Dim strbPfad As String 'hier benötigter Pfad Dim strGef As String MyPfad = ActiveDocument.path '& "\" & IniName 'Debug.Print MyPfad Dim rng As Range Dim strTmp As String Dim strTeilPfad As String strTmp = Left(MyPfad, InStrRev(MyPfad, "\") + 1) strTeilPfad = Left(strTmp, Len(strTmp) - 1) 'Debug.Print strTeilPfad strbPfad = strTeilPfad & "02_Ordner_Kopierkosten_Laufend\" 'Debug.Print strbPfad strGef = "Kopierkostenabrechnung.xlsm" Datei = strbPfad & strGef 'Debug.Print Datei ActiveDocument.MailMerge.OpenDataSource Name:= _ "C:\Users\Peter\Desktop\Kopierkosten-Abrechnung_2017_03_08\ _ 02_Ordner_Kopierkosten_Laufend\Kopierkostenabrechnung.xlsm" _ , 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=C:\Users\Peter\Desktop\ _ Kopierkosten-Abrechnung_2017_03_08\02_Ordner_Kopierkosten_Laufend\Kopierkostenabrechnung.xlsm; _ Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";J" _ , SQLStatement:="SELECT * FROM `Gesamtabrechnung$`", SQLStatement1:="", _ SubType:=wdMergeSubTypeAccess ' ActiveDocument.MailMerge.OpenDataSource Name:= _ ' Datei _ ' , 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=Datei;Mode=Read;Extended _ _ Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";J" _ ' , SQLStatement:="SELECT * FROM `Gesamtabrechnung$`", SQLStatement1:="", _ ' SubType:=wdMergeSubTypeAccess ActiveDocument.MailMerge.DataSource.QueryString = _ "SELECT * FROM `Gesamtabrechnung$` WHERE `Code` > 0 And `Ges#Anzahl` > 0 " ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ActiveDocument.MailMerge.OpenDataSource Name:= _ Datei _ , 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=" & Datei & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;""" & _ ";Jet OLEDB:System database="""";J", _ SQLStatement:="SELECT * FROM `Gesamtabrechnung$`", SQLStatement1:="", _ SubType:=wdMergeSubTypeAccess

Hallo Luschi,
leider kann ich Dir die beiden Dateien nicht übersenden, da diese sehr vertrauliche Daten enthalten.
Was das eigenartige ist, bei mir auf dem Rechner läuft das Programm einwandfrei, auf dem anderen Rechner ist ein kleiner Fehler vorhanden.
Das auszuführende Makro ist folgendens:
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()
Dim oWrd As Object, oDoc As Object
Dim wb As Workbook, ws As Worksheet
Dim strSheetName As String, xDocV As String, xSql As String
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(3)
strSheetName = ws.Name
'Ort der Word-Vorlage Serie3nbrief auf dem Datenträger
'hier wird davon ausgegangen, das sich Word- & Exceldatei im gleichen Verzeichnis befinden
'    xDocV = wb.Path & "\SB_Vorlage.docx"
xDocV = wb.Path & "\Serienbrief_Hauptformular_Lehrer_Klassen.docx"
'hierin befinden sich die {MergeField ...} und der sonstige Brieftext
Set oDoc = oWrd.Documents.Add(Template:=xDocV, NewTemplate:=False, DocumentType:=0)
oWrd.Visible = True
'neugeöffnete Datei in Serienbrief-Hauptdokument umwandeln
oDoc.MailMerge.MainDocumentType = wdFormLetters
'Fatenfeld-Auswahl in SQL-Schreibweise
xSql = "SELECT * FROM [Gesamtabrechnung$]"
'Datenquelle hinzufügen
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:="", 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

Der Fehler auf dem anderen Rechner besteht darin, dass er in diesem Bereich:
Set oDoc = oWrd.Documents.Add(Template:=xDocV, NewTemplate:=False, DocumentType:=0)
oWrd.Visible = True
das neue Worddokument öffnet aber er öffnet auch das Formular Sendungen - Empfänger auswählen.
Wenn ich dieses mit abbrechen beende, ist alles o.k.. Es werden die Daten ordnungsgemäss angezeigt.
Wie kann ich das Öffnen von Empfänger auswählen verhindern?
Gruss
Peter

Beliebteste Forumthreads (12 Monate)

Problem beim Öffnen word aus Excel

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread