Hi everyone
I have the following code that would import text from a textbox in a header, a textbox in the document body, and a table in the body. The details of this code is present on another thread http://www.vbaexpress.com/forum/show...der-into-excel:

    
     
     
     
Option Explicit
 
Dim j As Long
Dim Wrd As Object
 
Sub Test()
    Dim pth As Variant
    Dim arr As Variant
    Dim i As Integer
    pth = """C:\Users\home\Desktop\Uploaded\*.doc*"""


    Range("A:AZ").ClearContents
   
    
    j = 1
    arr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & pth & " /b /a-d /s").stdout.readall, vbCrLf), ".")
   
    On Error Resume Next
    Set Wrd = GetObject(, "Word.Application")
    If Wrd Is Nothing Then Set Wrd = CreateObject("Word.Application")
     
    Do
        DoEvents
    Loop Until Not Wrd Is Nothing
     
    On Error GoTo 0
    For i = LBound(arr) To UBound(arr)
        Call ImportWordTable(arr(i))
    Next i
    Wrd.Quit
    Set Wrd = Nothing
End Sub
 
 
Sub ImportWordTable(wdFileName As Variant)
    Dim wdDoc As Object
    Dim iRow As Long
    Dim iCol As Integer
    Dim x As Integer
    Dim oheader As HeaderFooter
    Dim oShp As Shape


    Dim arr, i
       On Error Resume Next
    If wdFileName = False Then Exit Sub




    Set wdDoc = Wrd.Documents.Open(wdFileName)


    
    If wdDoc.tables.Count > 0 Then
    
    
    With wdDoc
        
        
    
        With .tables(1)
           
            i = .Rows.Count * .Columns.Count
            x = 1
            ReDim arr(1 To i)
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    On Error Resume Next
                    arr(x) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                    On Error GoTo 0
                    x = x + 1
                Next iCol
            Next iRow
           
        End With
   
        
        
                With wdDoc.StoryRanges(5)
                    arr(2) = .Text
                End With




       For Each oheader In ActiveDocument.Sections(1).Headers
                If oheader.Exists Then
                    For Each oShp In oheader.Range.ShapeRange
                        If oShp.Type = msoTextBox Then
                            arr(3) = oShp.TextFrame.TextRange.Text
                            
                        End If
                    Next oShp
                End If
            Next oheader
             
       End With
         
         
        wdDoc.Close
        
        Set wdDoc = Nothing
        Set oheader = Nothing
        Set oShp = Nothing
        
        j = j + 1
        Cells(j, 1).Resize(, i).Value = arr
        
    End If
    Set wdDoc = Nothing
End Sub

However the code is generating an error :
"Run time error "13", type mismatch"
on the following step:
For Each oheader In ActiveDocument.Sections(1).Headers


Could anyone help me out please with that error? I am a bit stuck here

Another question: Some documents dont contain a textbox in the body of the document, so i need something similar to "If oheader.Exists Then" for the following part of the code:


             
 With wdDoc.StoryRanges(5)
                    arr(2) = .Text
                End With

Kind regards