Hi,

eine Textmarke ist bei einer Tabelle nicht erforderlich, aber man müsste die Zeile und Spalte der Tabelle sowie die Nummer der Tabelle wissen, aus der ausgelesen werden soll - dann wäre es sicher möglich, einen Code ganz konkret für deine Bedingungen zu posten.

Bis später,
Karin

Hallo Karin,

danke für deine Antwort.

Zeile und Spalte sind klar (jeweils die 2.), aber woher nehme ich die Nummer der Tabelle? Es ist die 3. Tabelle in dem Dokument, aber die Tabelleneigenschaften geben keine Nummer o.ä. her ... oder reicht diese Info schon und man muss im Code die "3. Tabelle" ansprechen?

Vielen Dank für deine Hilfe, Gruß
Jojo

Hi,

Word nummeriert die Tabellen automatisch.
Hier eine Möglichkeit, indem du die betreffende Word-Datei im vorgegebenen Ordner auswählst:

Sub WordtabelleEinlesen()
    Dim sPfad As String
    Dim appWord As Object
    Dim fd As FileDialog
    Dim arrDaten
    Dim strDatei As String
    Dim loLetzte As Long
    sPfad = "D:\Eigene Dateien\"    '<== Pfad anpassen
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Word-Dateien", "*.doc, *.docx", 1
        .InitialFileName = sPfad
        .AllowMultiSelect = False
        .Show
        strDatei = .SelectedItems(1)
    End With
    Application.ScreenUpdating = False
    If strDatei <> "" Then
        Set appWord = CreateObject("Word.Application")
        appWord.Visible = True
        appWord.Documents.Open strDatei
        arrDaten = Split(Application.Substitute(appWord.activeDocument.Tables(2), Chr(7), ""), Chr(13) & Chr(13))
        With ThisWorkbook.Worksheets("Tabelle1").Columns(1)
            loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
            Worksheets("Tabelle2").Range("A1").Resize(UBound(arrDaten)) = Application.Transpose(arrDaten)
            Worksheets("Tabelle2").Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :=Chr(13)
            .Cells(loLetzte, 1) = Worksheets("Tabelle2").Range("B2")
            Worksheets("Tabelle2").UsedRange.Clear
        End With
        appWord.activeDocument.Close savechanges:=False
        appWord.Quit
        Set appWord = Nothing
    End If
    Set fd = Nothing
End Sub

Die Daten werden in Tabelle1 Spalte A fortlaufend übernommen.

Der Code benutzt ein Hilfstabellenblatt (Tabelle2), in welches die Word-Tabelle komplett übernommen wird, sodass dann B2 (wohin Zeile 2/Spalte 2 der Wordtabelle übertragen wird) ausgelesen werden kann.

Bis später,
Karin

Hallo Karin,

das ist ja spitze!!! Ich bin sehr beeindruckt! Das codierst du einfach mal so "runter"? [kopfschütteln]

Optimal wäre es jetzt, wenn ich die Datei nicht selbst auswählen müsste, sondern einfach alle Dateien eines Ordners "abgegrast" werden. Ich müsste dann nur sicherstellen, dass ausschließlich dafür vorgesehene Dateien dort abgelegt werden.

Ist das auch möglich? Bzw. DASS, kann ich mir denken, aber WIE?

Vielen Dank im Voraus und viele Grüße
Jojo

Hi,

Sub WordtabelleEinlesen()
    Dim sPfad As String
    Dim appWord As Object
    Dim fd As FileDialog
    Dim arrDaten
    Dim strDatei As String
    Dim loLetzte As Long
    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
        If appWord.activeDocument.Tables.Count > 1 Then ' <== Abfrage ob mindestens 2 Tabellen enthalten sind
            arrDaten = Split(Application.Substitute(appWord.activeDocument.Tables(2), Chr(7), ""), Chr(13) & Chr(13))
            With ThisWorkbook.Worksheets("Tabelle1").Columns(1)
                loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                Worksheets("Tabelle2").Range("A1").Resize(UBound(arrDaten)) = Application.Transpose(arrDaten)
                Worksheets("Tabelle2").Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                    :=Chr(13)
                .Cells(loLetzte, 1) = Worksheets("Tabelle2").Range("B2")
                Worksheets("Tabelle2").UsedRange.Clear
            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

Hallo Karin,

das ist perfekt! Lesen und verstehen kann ich den Code prinzipiell. Kannst du mir aber bitte noch 2 Dinge erklären?
1. warum diese Zeile notwendig ist:

appWord.Visible = True

und 2. was in dieser Zeile genau passiert:

Worksheets("Tabelle2").Range("A1").Resize(UBound(arrDaten)) = Application.Transpose(arrDaten)

Das wäre sehr nett.

Vielen Dank, Gruß
Jojo

Hi,

zu 1. appWord.Visible = True bedeutet, dass die Word-Application (also Word als Programm) sichtbar ist. Du kannst es natürlich natürlich auch auf False setzen (oder die Zeile weglassen), dann läuft alles im Hintergrund ab ohne dass der Bearbeiter etwas merkt. Du hast allerdings ein Problem, falls das Programm (aus was für Gründen auch immer) mal mitten im Code abstürzt und Word bereits (unsichtbar) geöffnet ist: du musst den Rechner neu starten damit Word zurückgesetzt wird, denn anders kannst du nichts mehr mit Word machen, da es ja ausgeblendet ist.

zu 2. die Wordtabelle wird weiter oben im Code ja als Ganzes in die Array-Variable arrDaten eingelesen. Setze mal eine Überwachung auf die Variable und schau dir den Inhalt an - jede Zeile der Tabelle befindet sich in einem Feld des Arrays. Mit dieser Codezeile nun wird das Array ins Tabellenblatt geschrieben, wobei jedes Feld in eine Zelle in Spalte A eingetragen wird. In der nächsten Codezeile wird mittels Daten -> Text in Spalten die Spalte A in ihre einzelnen Bestandteile aufgelöst und in einzelne Spalten aufgeteilt. Dadurch kann dann das 2. Feld der 2. Zeile der Wordtabelle (entspricht B2 in der Exceltabelle) ausgelesen werden.
Man kann die Ausführung allerdings auch vereinfachen, indem man nicht das gesamte Array ausgibt, sondern nur das 2. Feld:

            With ThisWorkbook.Worksheets("Tabelle1").Columns(1)
                loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                Worksheets("Tabelle2").Range("A1") = arrDaten(1)
                Worksheets("Tabelle2").Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                    :=Chr(13)
                .Cells(loLetzte, 1) = Worksheets("Tabelle2").Range("B1")
                Worksheets("Tabelle2").UsedRange.Clear
            End With

In deinem konkreten Fall kann man sich allerdings auch den Umweg über ein Hilfstabellenblatt sparen, da man den Wert direkt aus dem Array relativ einfach extrahieren kann: definiere eine neue Variable strInhalt As String und ersetzte den gesamten Teilcode:

        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)) + 1)
            strInhalt = Mid(strInhalt, 1, InStr(strInhalt, Chr(13)) - 1)
            .Cells(loLetzte, 1) = strInhalt
        End With

Bei Wordtabellen mit vielen Spalten und der Notwendigkeit des Auslesens eines Feldes irgendwo in der Mitte der Zeile (oder auch wenn mehrere Felder ausgelesen werden sollen) ist das Zerlegen in Teil-Strings wesentlich komplizierter, weshalb sich da der Umweg über ein Hilfstabellenblatt anbietet.

Bis später,
Karin

Hallo Karin,

vielen Dank für die ausführliche Erklärung.
Leider bekomme ich in der Zeile

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

einen Laufzeitfehler 5 (Ungültiger Prozeduraufruf oder ungültiges Argument). Kannst du dir das erklären?

Gruß
Jojo

Hi,

den Fehler kann ich nicht nachvollziehen - in meiner Beispielmappe funktioniert der Code problemlos. Hast du mal nachgeschaut, was im Array-Feld 1 (= 2. Zeile der Word-Tabelle) steht bzw. was die Variable strInhalt in der vorhergehenden Zeile enthält?

Bis später,
Karin

Hi Karin,

im Array-Feld 1 steht bereits die korrekte Zeile aus der Word-Tabelle und in strInhalt steht der korrekte Feldinhalt aus der Word-Tabelle (ohne Leerzeichen davor oder dahinter).

Was passiert denn in der 2. Zeile, die mit strInhalt = ... beginnt? Ist diese vielleicht überflüssig?

Viele Grüße
Jojo

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

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

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

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

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

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

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

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

Hi Karin,

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

Vielen Dank, Grüße
Jojo

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