Looping through multiple word files

[stevehoops5]

Hi All,

I'm having trouble looping through all of the word files in a folder. I am trying to pull a table from each word file in a folder. My ImportWordTable sub works fine when i have the wdFileName picked with a browser. It doesn't seem to do anything when I try to set it to MyFile so that I can loop through. The problem seems to be with "wdFileName = MyFile" which is in the ImportWordTable sub. Any Ideas on what I'm doing wrong?

Sub DirLoop()

      Dim MyFile As Variant, Sep As Variant
Call Choose
      Sep = Application.PathSeparator
         MyFile = Dir(refreshLocation & Sep & "*doc")
      Do While MyFile <> ""
Call ImportWordTable
         MyFile = Dir()
      Loop
   End Sub

Sub Choose()
Dim refreshLocation As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
refreshLocation = .SelectedItems(1)
End With
End Sub

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim lasty As Integer
lasty = LastRow(ActiveSheet)


wdFileName = MyFile


If wdFileName = False Then Exit Sub '(user cancelled import file browser)


Set wdDoc = GetObject(wdFileName) 'open Word file




With wdDoc
With .tables(.tables.Count)
'copy cell contents from Word table cells to Excel cells


For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
    If iRow = 1 Then GoTo Nexts Else
Cells(iRow + lasty, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)


Nexts:
Next iCol
Next iRow
End With
End With


Set wdDoc = Nothing


End Sub

:

 

[Damon Ostrander]

Hi Steve,

I believe the problem is that the scope of the variable MyFile is local to Sub DirLoop, so is not recognized within Sub ImportWordTable. There are several ways to fix this, but in this case the method I favor is to pass it to ImportWordTable as an argument. Here's your code modified to do that:

Sub DirLoop()

      Dim MyFile As Variant, Sep As Variant
Call Choose
      Sep = Application.PathSeparator
         MyFile = Dir(refreshLocation & Sep & "*doc")
      Do While MyFile <> ""
         ImportWordTable MyFile
         MyFile = Dir()
      Loop
   End Sub

Sub Choose()
Dim refreshLocation As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
refreshLocation = .SelectedItems(1)
End With
End Sub

Sub ImportWordTable(wdFileName As Variant)
Dim wdDoc As Object
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim lasty As Integer
lasty = LastRow(ActiveSheet)

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
With .tables(.tables.Count)
'copy cell contents from Word table cells to Excel cells

For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
    If iRow = 1 Then GoTo Nexts Else
Cells(iRow + lasty, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)


Nexts:
Next iCol
Next iRow
End With
End With


Set wdDoc = Nothing


End Sub

I should also mention that your code will not find .docx Word files produced by versions of Word later than Word 2003. You could use Dir(refreshLocation & Sep & "*.doc*") to cover both .doc and .docx files. Note that the "." is important so as not to inadvertently match files with "doc" in the name.

Damon

 

[stevehoops5]

Thanks for your reply. I ended up just including the code from the importwordtable sub into the main sub. I also made a few other edits:

Sub Choose()
Dim refreshLocation As String




With Application.FileDialog(msoFileDialogFolderPicker)


.Show


refreshLocation = .SelectedItems(1)


End With
Range("Refresh_Location") = refreshLocation & "\"


End Sub




Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = Range("A:A").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
    On Error GoTo 0
End Function


    
    
Sub DirLoop()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim lasty As Integer
Dim MyFile As String, Sep As String


Call Choose
      Sep = Application.PathSeparator
      MyFile = Dir(Range("refresh_location").Value & Sep & "*doc")
    Do While MyFile <> ""


        wdFileName = (Range("refresh_location").Value & MyFile)
        Set wdDoc = GetObject(wdFileName) 'open Word file
        lasty = LastRow(ActiveSheet)
            With wdDoc
            With .tables(.tables.Count)
                For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    If iRow = 1 Then GoTo Nexts Else
                Cells(iRow + lasty, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                Range("f" & iRow + lasty) = (Mid(MyFile, InStr(1, MyFile, "C_C"), 7))
Nexts:
            Next iCol
            Next iRow
            End With
            End With


        Set wdDoc = Nothing
        MyFile = Dir()
    Loop
End Sub

I will make sure to update the refresh location to *.doc* as you suggest.