Fix VBA macro importing multiple Word tables to excel

mrMadCat

New Member
Joined
Jun 8, 2016
Messages
39
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
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.

Code:
    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
 
Last edited:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
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.

Code:
[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]
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top