26.05.2011

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

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...