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
|