Fix VBA macro importing multiple Word tables to excel

[mrMadCat]

Hi!
I've found a macro that should copy tables from all the Word documents to one excel sheet. This is what I need but it is not working for me. It opens new excel file and stops with Runtime-Error 424 saying Object required.
There are few hundred doc files which contain some text and some tables, data from this tables I need to import. In fact I need to import only a specific cell, but this would make macro more complex.
Would appreciate any help. Thnx.

    Sub Macro1()    Dim xl As Object
    Set xl = CreateObject("excel.application")


    xl.Workbooks.Add
    xl.Visible = True


    'Here put your path where you have your documents to read:
    myPath = "D:\banka\"  'End with '\'
    myFile = Dir(myPath & "*.doc")
    
    xlRow = 1
    Do While myFile <> ""
    Documents.Open Filename:=myPath & myFile, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""


    xlCol = 0
    For Each t In ActiveDocument.Tables
        For Each r In t.Rows
            For Each c In r.Range.Cells
                myText = c
                myText = Replace(myText, Chr(13), "")
                myText = Replace(myText, Chr(7), "")
                xlCol = xlCol + 1
                xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol) = myText


            Next c
            xlRow = xlRow + 1
            xlCol = 0
            xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, xlCol + 1) = myFile
            xlRow = xlRow + 1
       Next r
    Next t
    ActiveWindow.Close False


      myFile = Dir
   Loop


   xl.Visible = True
End Sub

 

[AlphaFrog]

Your code presumes you are running it from MS-Word and not from Excel. Is that the case or are you running it from Excel?

This code can run from Excel.

[color=darkblue]Sub[/color] Macro2()
    
    [color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wrd [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Set[/color] wrd = CreateObject("Word.Application")
    [color=green]'wrd.Visible = True[/color]
    
    [color=darkblue]Set[/color] ws = Sheets.Add(After:=Sheets(Sheets.Count))
    
    [color=green]'Here put your path where you have your documents to read:[/color]
    [color=green]'myPath = "C:\test\"  'End with '\'[/color]
    myPath = "D:\banka\"  [color=green]'End with '\'[/color]
    myFile = Dir(myPath & "*.doc")
    
    xlRow = 1
    [color=darkblue]Do[/color] [color=darkblue]While[/color] myFile <> ""
        [color=darkblue]With[/color] wrd.Documents.Open(Filename:=myPath & myFile)
    
            xlCol = 0
            [color=darkblue]For[/color] [color=darkblue]Each[/color] T [color=darkblue]In[/color] .Tables
                [color=darkblue]For[/color] [color=darkblue]Each[/color] r [color=darkblue]In[/color] T.Rows
                    [color=darkblue]For[/color] [color=darkblue]Each[/color] c [color=darkblue]In[/color] r.Range.Cells
                        myText = c
                        myText = Replace(myText, Chr(13), "")
                        myText = Replace(myText, Chr(7), "")
                        xlCol = xlCol + 1
                        ws.Cells(xlRow, xlCol) = myText
                    [color=darkblue]Next[/color] c
                    xlRow = xlRow + 1
                    xlCol = 0
                    ws.Cells(xlRow, xlCol + 1) = myFile
                    xlRow = xlRow + 1
                [color=darkblue]Next[/color] r
            [color=darkblue]Next[/color] T
            .Close [color=darkblue]False[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        
        myFile = Dir
    [color=darkblue]Loop[/color]
    
    wrd.Quit
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]