Tabellenfeld aus Word-Datei auslesen und in Excel-Datei einfügen

Question

Hallo,
ich möchte aus Word-Dateien, die alle gleich aufgebaut sind, den Inhalt eines Tabellenfeldes auslesen und in ein xls-sheet einfügen. Muss ich hierfür die Word-Datei an der entsprechenden Stelle mit einer Textmarke o.ä. versehen?
Idealerweise durchsucht ein VBA-Code einen Ordner, in dem die Word-Dateien abgelegt sind und liest eine nach der anderen aus und fügt den Feldinhalt untereinander in das xls-sheet ein.

Hat hierfür jemand eine Lösung bzw. den notwendigen VBA-Code?

Vielen Dank, Gruß
Jojo

Answer 1

Hi,

in der Zeile

strInhalt = Mid(arrDaten(1), InStr(arrDaten(1), Chr(13)) + 1)

wird der linke Teil (= 1. Feld der Wordtabelle) abgetrennt und der Rest auf die Variable geschrieben. In der Zeile

strInhalt = Mid(strInhalt, 1, InStr(strInhalt, Chr(13)) - 1)

wird dann der rechte Teil (= alles ab dem nunmehr 2. Feld, ehemals 3. Feld der Wordtabelle bis zum Ende) abgetrennt, sodass letztendlich nur der Inhalt des 2. Feldes der Wordtabelle übrig bleibt. Wenn deine Wordtabelle allerdings nur 2 Spalten hat (was jedoch in keinem deiner Beiträge stand), läuft der Code natürlich auf einen Fehler, denn es ist kein Chr(13) mehr enthalten. In diesem Fall kannst du die 2. Codezeile weglassen.
Oder du verallgemeinerst den Code (falls eine Tabelle doch einmal mehr als nur 2 Spalten hat) und prüfst vorher, ob noch weitere Chr(13) im String enthalten sind. Dann würde diese Codezeile so aussehen:

If Len(Application.Substitute(strInhalt, Chr(13), "")) <> Len(strInhalt) Then _
strInhalt = Mid(strInhalt, 1, InStr(strInhalt, Chr(13)) - 1)

Bis später,
Karin

Answer 2

Hallo Karin,

so ist es nun wirklich perfekt! War natürlich mein Fehler, nichts von der fehlenden 3. Spalte zu schreiben ...

Ich bin begeistert und danke dir sehr! Viele Grüße
Jojo

Answer 3

Hallo Karin,

jetzt hab' ich doch noch eine Frage:

Wenn ein Word-Dokument bereits geöffnet ist, kommt - während der VBA-Code läuft - die msgbox, in der ich wählen muss, ob ich die Datei schreibgeschützt öffnen möchte.

Dies habe ich versucht, mit

appWord.Documents.Open strPfad & strDatei, Revert:=False

zu unterdrücken, was leider nicht funktioniert.

Kannst du mir sagen, warum?

Vielen Dank, Gruß
Jojo

Answer 4

Sorry Karin,

ich hätte noch etwas länger suchen sollen ...

Der korrekte Befehl lautet wohl:

appWord.Documents.Open strPfad & strDatei, , True

Trotzdem danke!

Viele Grüße und ein schönes WE
Jojo

Answer 5

Hallo Karin,

leider muss ich deine Hilfe nochmal in Anspruch nehmen, nachdem ich beim Testen auf ein Problem gestoßen bin und es nicht selbst lösen kann. Vermutlich muss man an die folgende Zeile ran, aber ich weiß nicht, wie ...

arrDaten = Split(Application.Substitute(appWord.activeDocument.Tables(2), Chr(7), ""), Chr(13) & Chr(13))

Die einzelnen Inhalte des arrays sind nämlich unterschiedlich, jenachdem wieviele Absatzmarken innerhalb eines Word-Tabellenfeldes gesetzt wurden. Insbesondere, wenn das letzte Zeichen (oder gar mehrere) eine Absatzmarke ist. Dann verschieben sich die Inhalte der folgenden Felder "nach hinten" und der angezeigte Feldinhalt ist nicht der gewollte.

Wie gesagt, ich habe jetzt mit allen möglichen Codezeilen rumprobiert, bekomme es aber nicht hin.

Kannst du mir bitte nochmal helfen?

Das wäre sehr nett, viele Grüße
Jojo

Answer 6

Hi,

versuche es mal so:

Sub WordtabelleEinlesen()
Dim sPfad As String
Dim appWord As Object
Dim fd As FileDialog
Dim arrDaten
Dim strDatei As String
Dim loLetzte As Long
Dim strInhalt As String
sPfad = "D:\Eigene Dateien\" '<== Pfad anpassen
Application.ScreenUpdating = False
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
strDatei = Dir(sPfad & "*.docx") '<== Dateiendung anpassen
Do While strDatei <> ""
appWord.Documents.Open sPfad & strDatei, , True
If appWord.activeDocument.Tables.Count > 1 Then ' <== Abfrage ob mindestens 2 Tabellen enthalten sind
arrDaten = Split(appWord.activeDocument.Tables(3), Chr(7) & Chr(13) & Chr(7))
With ThisWorkbook.Worksheets("Tabelle1").Columns(1)
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
strInhalt = Mid(arrDaten(1), InStr(arrDaten(1), Chr(13) & Chr(7)) + 2)
If Len(Application.Substitute(strInhalt, Chr(13), "")) <> Len(strInhalt) Then _
strInhalt = Mid(strInhalt, 1, InStr(strInhalt, Chr(13) & Chr(7)) - 2)
.Cells(loLetzte, 1) = Application.Substitute(strInhalt, Chr(13), Chr(10))
.Cells(loLetzte, 1).WrapText = True
End With
End If
appWord.activeDocument.Close savechanges:=False
strDatei = Dir
Loop
appWord.Quit
Set appWord = Nothing
Set fd = Nothing
End Sub

Bis später,
Karin

Answer 7

Hallo Karin,

vielen Dank für deine Hilfe. Leider klappt es so auch nicht in jedem Fall. Aber inzwischen habe ich mir so geholfen, dass ich direkt auf die Tabellenfelder zugreife (die Struktur der Word-Tabellen darf sich ohnehin nicht ändern ...)

.Cells(loLetzte, 1) = Application.Substitute(Application.Substitute(appWord.activeDocument.Tables(2).Cell(2, 2), Chr(13), ""), Chr(7), "")

Ich danke dir für die ausdauernde, super Hilfe!!!

Ein schönes Wochenende, viele Grüße
Jojo

Answer 8

Hi,

das Problem bei Wordtabellen ist, dass man nicht unbedingt in jedem Fall eindeutig unterscheiden kann, ob sich das Chr(13) in dem String, der als Tabellenzeile ausgelesen wird, durch einen Zeilenumbruch im Tabellenfeld oder durch das Feldeende ergibt. Deshalb ist es schwierig, die einzelnen Felder richtig zu trennen. Da du immer das selbe Feld ausliest, ist es aber natürlich einfacher, direkt auf das Feld ohne Umweg über das Array zuzugreifen - da hast du Recht. Allerdings würde ich die zu ersetzenden Zeichen etwas anders setzen, denn in deinem Code wird auch der Zeilenumbruch gelöscht.

Application.Substitute(Application.Substitute(appWord.activeDocument.Tables(2).Cell(2, 2), Chr(13) & Chr(7), ""), Chr(13), Chr(10))

Bis später,
Karin

Answer 9

Hi Karin,

stimmt - so ist es NOCH schöner ;-)

Vielen Dank, Grüße
Jojo

Answer 10

Hallo,

jetzt habe ich noch eine Bitte (leider bekomme ich es nicht selbst hin ...)

Ich habe jetzt nicht nur einen "sPfad", in dem die Dateien liegen, sondern die Dateien können in allen darunterliegenden Unterordnern sein - und die muss ich auch öffnen.

Könnt' ihr mir bitte nochmal helfen?

Vielen Dank, Gruß
Jojo