How to extract text from a shape in the header with VBA in Word?

Question

I have an auto generated report that comes in as a pdf. Ultimately, I need this to end up in Excel, but if I export to Excel I lose the headers/footers which contain data I need. I can export to Word, which keeps the headers, but I need to get the text out of the header so it can be saved as a plain text file to be accessed in Excel.

Each page has a header. Some pages also have data in the footer. I'm looking for something that will put the header at the top of the body text of each page and, if there is anything in the footer, put text from the footer at the bottom.

The text in the header and footer is contained in shapes which are seemingly named at random. There are three shapes per header and three per footer, if the footer contains any text.

I haven't built a loop or attempted to deal with the footer, as I can't get text out of the header in a usable manner yet.

Most of my attempts have started with: activedocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Copy

And ended with an error/failure at some iteration of the following:

activedocument.Sections(1).Range.PasteSpecial datatype:=wdPasteText

This returns Run-time error '4198':Command Failed. Other datatypes return text boxes that are lost when converting to the plain text file. Regular paste puts text back in the header.

I'm not very familiar with VBA in a Word setting, so any advice is much appreciated. Thanks!

Answer 1

• section.Headers(wdHeaderFooterPrimary).Shapes is a collection of shapes in BOTH headers and footers although Headers() is in the code.
• The right way to get the shapes collcection in headers is section.Headers(wdHeaderFooterPrimary).Range.ShapeRange.

Option Explicit
' This is Word VBA code
Sub ExtractHeaderFooter()
    Dim doc As Document
    Dim section As section
    Dim oShape As shape
    Dim text As String, i As Long
    Set doc = ActiveDocument
    For Each section In doc.Sections
        i = 1
        For Each oShape In section.Headers(wdHeaderFooterPrimary).Range.ShapeRange
            text = oShape.TextFrame.TextRange.text
            Debug.Print "Header Shape " & i & " : " & text
            ' Debug.Print oShape.Top, oShape.Left
            i = i + 1
        Next oShape
        i = 1
        For Each oShape In section.Footers(wdHeaderFooterPrimary).Range.ShapeRange
            text = oShape.TextFrame.TextRange.text
            Debug.Print "Fooer Shape " & i & " : " & text
            ' Debug.Print oShape.Top, oShape.Left
            i = i + 1
        Next oShape
    Next section
End Sub