Worddateien - Tabelle nach Excel kopieren!

Frage: Aus vielen Worddokumenten soll eine Tabelle in Excel kopiert werden - jeweils auf ein neues Tabellenblatt. Es kann auch der gesamte Inhalt des Worddokumentes kopiert werden. Bitte den Pfad im Code anpassen.

Worddateien - Tabelle nach Excel kopieren...[ZIP, 90 KB]

Option Explicit
Dim blnTMP As Boolean
Public Sub Test()
Dim objDocument As Object
Dim strDatei As String
Dim strPfad As String
Dim objApp As Object
On Error GoTo Fin
' Pfad anpassen
strPfad = "C:\TMP\"
Set objApp = OffApp("Word")
' Word nicht sichtbar
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
strDatei = Dir$(strPfad & "*.doc*", vbDirectory)
Do While strDatei <> ""
Set objDocument = objApp.Documents.Open _
(strPfad & strDatei)
' Die erste Tabelle wird kopiert
objDocument.Tables(1).Range.Copy
' Der gesamte Inhalt wird kopiert
'objDocument.Range.Copy
' und in ein neues Tabellenbatt eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Paste
' Worddokument ohne speichern schlissen
objDocument.Close False
' Die nächste Datei nehmen
strDatei = Dir$()
Loop
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
Set objApp = Nothing
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function

Kommentare

  1. Hallo

    Besten Dank für den Code und die Bereitstellung! Diesen Code bräuchte ich so ergänzt, dass es die Word-Dateien im Unter-Ordnern auch bearbeitet werden. Geht das?

    Beste Grüsse
    Kaya

    AntwortenLöschen
    Antworten
    1. Dann nimm:
      http://vbanet.blogspot.de/2012/07/alle-dateien-eines-ordners-optional-mit.html

      Und bastel das um. :-)

      Löschen
  2. Danke für den Tip. Ich schaffs leider nicht, da ich mich mit VBA nicht so auskenne! Ich weiss nur wo ich den Code platzieren muss, mehr nicht :-(

    Beste Grüsse
    Kaya

    AntwortenLöschen

Kommentar veröffentlichen

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...