Clever-Excel-Forum

Seiten: 1 2 3 4

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

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

Zitat: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

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

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:

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.

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

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

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

(14.09.2017, 14:51)Eichi06 schrieb: [ -> ]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

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

Seiten: 1 2 3 4

Eichi06

Helvetier

Eichi06

Helvetier

Eichi06

snb

Eichi06

Helvetier

Jeanie

snb