Word - Kopf- Fußzeile auslesen!

Im folgenden ein Beispiel, wie aus Worddateien die Kopf- bzw. Fußzeile ausgelesen wird. Die Liste der Worddateien ist in Spalte B. Die Dateien sind im gleichen Verzeichnis wie die Exceldatei mit dem Code. Im Download sind Wordbeispieldateien enthalten.

Worddateien Kopf- Fußzeile auslesen...[ZIP, 110 KB]

Option Explicit
Dim blnTMP As Boolean
Public Sub Test()
Dim strFileName As String
Dim objWDD As Object
Dim objApp As Object
Dim lngRow As Long
On Error GoTo Fin
Set objApp = OffApp("Word")
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
With Tabelle1
For lngRow = 1 To .Range("B" & .Rows.Count) _
.End(xlUp).Row
strFileName = .Cells(lngRow, 2).Value
If Dir(strFileName) <> "" Then
objApp.Documents.Open _
ThisWorkbook.Path & "\" & strFileName
Set objWDD = objApp.Documents(1)
.Cells(lngRow, 3).Value = _
objWDD.Sections(1) _
.Headers(1).Range.Text
.Cells(lngRow, 4).Value = _
objWDD.Sections(1) _
.Footers(1).Range.Text
objApp.ActiveDocument.Close False
Else
.Cells(lngRow, 3).Value = _
"Datei nicht vorhanden!"
End If
Next lngRow
End With
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
Set objWDD = Nothing
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

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

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