Hallo zusammen,

Ich habe in einem directory mehrere Word Files die alle gleich struckturiert sind und alle ein ExcelObjekt beinhalten.

Jetzt möchte ich ein Excel file automatisch mit VBA erstellen welches die werte des ExcelObjekts in den Word dateien ausliest und ins excel file überträgt.

Das ganze habe ich hinbekommen, jedoch waren damals die WordFiles nur mit einer einfachen Word Tabelle versehen die sich jetzt eben in ein ExcelObjekt tabelle geändert hat und mein code funkt nicht mehr.

Sub Test()
    Dim cL As Object
    Dim sPfad As String
    Dim appWord As Object
    Dim i As Long
    Dim a As Long
    Dim t As Long
    Dim counter As Long
    Dim cDir As String
    Dim v As String

    
    
    'WordObject erstellen
    Set appWord = CreateObject("Word.Application")

    
    'Pfad
    sPfad = "C:\temp\"
    
    cDir = Dir(sPfad & "*.doc")
    
    counter = 0
    t = 3
    i = 0
    
   
   
   appWord.Documents.Open(sPfad & cDir, ReadOnly = True).Application.Visible = False
   ActiveWorkbook.ActiveSheet.Cells(5, 5) = Left(v, Len(v) - 2)
   
   
   
    Do While cDir <> ""
        'Worddocument öffnen
        appWord.Documents.Open(sPfad & cDir, ReadOnly = True).Application.Visible = False
        
        'Wordtabelle auslesen
        'überschriften
        v = appWord.ActiveDocument.Tables(2).Cell(1, 1).Range.Text
        ActiveWorkbook.ActiveSheet.Cells(t + counter, 1) = Left(v, Len(v) - 2)

        'Zeilen
        For a = 2 To 6
            i = i + 1
            'Spalten
            For Each cL In appWord.ActiveDocument.Tables(4).Columns(a).Cells
                i = i + 1
                ActiveWorkbook.ActiveSheet.Cells(t + counter, i) = Left(cL.Range.Text, Len(cL.Range.Text) - 2)
            Next
        Next a
        
        'Worddocument schliessen
        appWord.ActiveDocument.Close savechanges:=False

        'nächstes Document lesen
        cDir = Dir
        counter = counter + 1
        i = 0
   Loop
    
    'WordObject löschen
    Set appWord = Nothing
End Sub

Danke für eure hilfe