Aus Excel mit VBA Serienbrief im Word speichern

[Eichi06]

Hallo ihr Lieben,
ich bin heute an die Grenze meiner VBA-Kenntnisse gestoßen. Folgendes Problem habe ich dabei:

Ich habe im Excel eine Art Datenbank erstellt. Über verschiedene Userformen können Personen neu angelegt oder aufgerufen werden. Hier sind dann verschiedene Daten wie Name, Wohnort und ähnliches hinterlegt. Aus einer dieser Userformen will ich über einen Button direkt für die jeweilig aufgerufene Person einen Serienbrief erstellen. Die Serienbriefdatei wurde bereits erstellt und mit der Tabelle verknüpft. Wichtig wäre eventuell noch, dass sich die Userformen, also das Programm und die Ergebnisliste in einer Datei befinden. 

Ich habe bereits folgenden Code für die Verknüpfung zu Word erstellt:

Code:

Option Explicit

Sub fp_Excel_Word_Serienbrief_erstellen()

Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range


'*diese Funktion oeffnet den Serienbrief "Serienbrief.docx"
Dim sFilename As String
sFilename = "H:\Eigene Datein\Aktuelle Aufgaben\Serienbriefvorlagen\Serienbrief.docx"

'< Word starten >
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
'</ Word starten >

'< Word Document oeffnen >
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)

'Anweisung in Word aufgezeichnet
'Sendung zusammenführen
'Zahl 1 einfügen um 1. Ergebniss zu erhalten
'diese Datei abspeichern

With ActiveDocument.MailMerge
       .Destination = .wdSendToNewDocument
       .SuppressBlankLines = True
       With .DataSource
           .FirstRecord = 1
           .LastRecord = 1
       End With
       .Execute Pause:=False
   End With
   ChangeFileOpenDirectory "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\"
   ActiveDocument.SaveAs2 Filename:= _
       "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\Max Mustermann.docx", _
       FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
       AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
       EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
       :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
   ActiveWindow.Close


End Sub

 In der Excel-Entwicklungsumgebung habe ich über Extras - Verweise schon Microsoft Word 14.0 Object Library aktiviert. Ich benutze Office 2010
Wenn ich den Code ausführe kommt folgende Fehlermeldung.
Fehler beim Kompilieren
Methode oder Datenobjekt nicht gefunden
Klicke ich hier auf ok, markiert er mir .Destination = .wdSendToNewDocument 
Habt ihr eventuell eine Lösung für mein Problem?
vielen dank schon mal
Gruß Felix

[Helvetier]

Hallo Felix
Versuch es mal mit diesem Code. Ich konnte Ihn hier nicht testen wegen der fehlenden Quelle. Aber der der Debugger bracht.wdSendToNewDocumente mal keinen Kompilierungsfehler. Ich habe nur einen Verweis gemacht auf das WordObject und denn im Code  dem .wdSendToNewDocument WordObj vorne angestellt.
Gruss

Sub fp_Excel_Word_Serienbrief_erstellen()
Dim WordObj As Object
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range

'*diese Funktion oeffnet den Serienbrief "Serienbrief.docx"
Dim sFilename As String
 sFilename = "H:\Eigene Datein\Aktuelle Aufgaben\Serienbriefvorlagen\Serienbrief.docx"
'< Word starten >
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
 wordApp.Visible = True
'
'< Word Document oeffnen >
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)
'Anweisung in Word aufgezeichnet
'Sendung zusammenführen
'Zahl 1 einfügen um 1. Ergebniss zu erhalten
'diese Datei abspeichern
With ActiveDocument.MailMerge
        .Destination = WordObj.wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = 1
            .LastRecord = 1
        End With
        .Execute Pause:=False
    End With
    ChangeFileOpenDirectory "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\"
    ActiveDocument.SaveAs2 Filename:= _
        "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\Max Mustermann.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
    ActiveWindow.Close

End Sub

[Eichi06]

Danke für deinen Beitrag. Nun erscheint nicht mehr meine Fehlermeldung sondern eine neue:

Laufzeitfehler '91':
Objektvariable oder With-Blockvariable nicht festgelegt

Klicke ich dann auf Debuggen kommt ebenfalls wieder die selbe Zeile als Fehler

[Helvetier]

Es ist ein Ratespiel: die Testumgebung (Datenquelle, Datensenke) fehlt hier und aufbauen mag ich sie nicht.

Code:

Sub fp_Excel_Word_Serienbrief_erstellen()
Dim WordObj As Object
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range


'*diese Funktion oeffnet den Serienbrief "Serienbrief.docx"
Dim sFilename As String
sFilename = "H:\Eigene Datein\Aktuelle Aufgaben\Serienbriefvorlagen\Serienbrief.docx"

'< Word starten >
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
'</ Word starten >

'< Word Document oeffnen >
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)

'Anweisung in Word aufgezeichnet
'Sendung zusammenführen
'Zahl 1 einfügen um 1. Ergebniss zu erhalten
'diese Datei abspeichern

With ActiveDocument.MailMerge
       .Destination = WordObj.wdSendToNewDocument
       .SuppressBlankLines = True
       With WordObj.DataSource
           .FirstRecord = 1
           .LastRecord = 1
       End With
       .Execute Pause:=False
   End With
   ChangeFileOpenDirectory "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\"
   ActiveDocument.SaveAs2 Filename:= _
       "H:\Eigene Datein\Aktuelle Aufgaben\Testdateien\Max Mustermann.docx", _
       FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
       AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
       EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
       :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
   ActiveWindow.Close
End Sub

Teste dfies:

[Eichi06]

Leider bringt das auch keinen Erfolg.

Ich hab dir mal ein Zip-Ordner mit Probedateien gemacht. Dort musst du nur die entsprechenden Pfade ändern. Eventuell bringt dir/euch das was.

[snb]

2 Fehler

1. sendtonewdocument ist kein Eigenschaft: also die Punkt kreiert ein Fehler
2. in LateBinding erkennt VBA keine 'Worte': parameter sendtonewdocument=0

     

Code:

With getObject("H:\Eigene Datein\Aktuelle Aufgaben\Serienbriefvorlagen\Serienbrief.docx").MailMerge
       .Destination = 0

[Eichi06]

Danke für den Beitrag, aber selbst wenn ich das ändere, kommt wieder eine Fehlermeldung:

Laufzeitfehler '5852'
Das angeforderte Objekt ist nicht verfügbar

Klicke ich auf Debuggen kommt markiert er mir dann: .Destination = 0

[Helvetier]

Hallo snb
Du hast den Fehler gefunden und kannst dem Eichi sicher mit links den Code korrigieren. Danke!
Gruss

[Jeanie]

Danke für den Beitrag, aber selbst wenn ich das ändere, kommt wieder eine Fehlermeldung:

Laufzeitfehler '5852'
Das angeforderte Objekt ist nicht verfügbar

Klicke ich auf Debuggen kommt markiert er mir dann: .Destination = 0

probier mal

With ActiveDocument.MailMerge
With doc.MailMerge

[snb]

Diese Code reicht:

Code:

Sub M_snb()
   With GetObject(ThisWorkbook.Path & "\Serienbrief.docx")
        With .MailMerge
            .Destination = 0
'            .OpenDataSource ThisWorkbook.FullName
            .Execute
        End With
    
        .Application.ActiveDocument.SaveAs2 ThisWorkbook.Path & "\Max Mustermann.docx"
        .Application.ActiveDocument.Close 0

        .Save
        .Close 0
    End With
End Sub