autom. Einlesen einer Word dotx Datei

Sub FormularfelderNachExcel()



    Dim wdApp As Object

    Dim wdDoc As Object

    Dim pfad As String

    Dim ws As Worksheet

    Dim freieZeile As Long



    Set ws = ThisWorkbook.Sheets("Mitglied_1")



    ' nächste freie Zeile ermitteln (Spalte A als Referenz)

    freieZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1



     pfad = "C:\Users\Pongi\Documents\Richie Privat\Datenbanken\Testdb\Testimport.docx" 'Word Datei



    ' Word starten

    On Error Resume Next

    Set wdApp = GetObject(, "Word.Application")

    If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")

    On Error GoTo 0



    wdApp.Visible = False

'    ' Dokument öffnen

    Set wdDoc = wdApp.Documents.Open(pfad)

     For i = 1 To 11

        ThisWorkbook.Sheets(1).Cells(letzteZeile, i).Value = wdDoc.FormFields(i).Result.Text

    Next i

'    'Formularfelder: Verwenden Sie wdDoc.FormFields("Name").Result

'    With wdDoc

'        ws.Cells(freieZeile, 1).Value = .FormFields("Name").Result

'        ws.Cells(freieZeile, 2).Value = .FormFields("Vorname").Result

'        ws.Cells(freieZeile, 3).Value = .FormFields("Abteilung").Result

'        ws.Cells(freieZeile, 4).Value = .FormFields("Art").Result

'        ws.Cells(freieZeile, 5).Value = .FormFields("Datum").Result

'        ws.Cells(freieZeile, 6).Value = .FormFields("Ort").Result

'        ws.Cells(freieZeile, 8).Value = .FormFields("Thema").Result

'        ws.Cells(freieZeile, 9).Value = .FormFields("Beginn").Result

'        ws.Cells(freieZeile, 10).Value = .FormFields("Ende").Result

'        ws.Cells(freieZeile, 11).Value = .FormFields("Vb-Zeit").Result

'    End With



    ' Word schließen

    wdDoc.Close False

    wdApp.Quit



    ' Objekte freigeben

    Set wdDoc = Nothing

    Set wdApp = Nothing



    MsgBox "Daten erfolgreich in Zeile " & freieZeile & " eingefügt!"



End Sub