Find and Replace in Multiple word Docs

Sub FindReplaceMultipleDocs()
 Dim oDoc As Document
 Dim fileNameArr(0 To 2) As String

 fileNameArr(0) = "C:\Document\A1.doc"
 fileNameArr(1) = "C:\Document\A2.doc"

 For fileNam = LBound(fileNameArr) To UBound(fileNameArr)
   
   WordBasic.DisableAutoMacros 1
   Set oDoc = Documents.Open(fileNameArr(fileNam))

   'Iterate through all story types in the current document
   For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
     With rngStory.Find
      .Text = "<agencyAddress>"
      .Replacement.Text = "<csaAddressLine1>"
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
     End With
     With rngStory.Find
       .Text = "<agencyAddressLine1>"
       .Replacement.Text = "<csaAddressLine1>"
       .Wrap = wdFindContinue
       .Execute Replace:=wdReplaceAll
     End With
     'Get next linked story (if any)
     Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
     Next
  
   oDoc.SaveAs FileName:=fileNameArr(fileNam)
   oDoc.Close SaveChanges:=wdDoNotSaveChanges

   WordBasic.DisableAutoMacros 0
 Next fileNam
End Sub

Import Word Tables into Excel

Sub ImportWordTableIntoExcel()
 Dim wdDoc As Object
 Dim TableNo As Integer 'table number in Word
 Dim nRow As Long 'row index in Excel
 Dim nCol As Long 'row index in Excel
 Dim iRow As Long 'row index in Excel
 Dim iCol As Integer 'column index in Excel
 Dim fileNameArr(0 To 1) As String
 fileNameArr(0) = "C:\Documents\A1.doc"
 fileNameArr(1) = "C:\Documents\A2.doc"
 nRow = 1
 For fileNam = LBound(fileNameArr) To UBound(fileNameArr)
   
  Set wdDoc = GetObject(fileNameArr(fileNam)) 'open Word file
 
  With wdDoc
   TableNo = wdDoc.tables.Count
  
   If TableNo > 2 Then
    With .tables(TableNo - 3)
     'copy cell contents from Word table cells to Excel cells
     For iRow = 1 To .Rows.Count
      nCol = 1
      Cells(nRow, nCol) = fileNameArr(fileNam)
      nCol = nCol + 1
     
      For iCol = 1 To .Columns.Count
       Cells(nRow, nCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
       nCol = nCol + 1
      Next iCol
      nRow = nRow + 1
     Next iRow
    End With
   End If
  End With
 
  Set wdDoc = Nothing
 Next fileNam
End Sub

Get File Names from Child Directory

Sub GetFilesFromDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
 

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Documents\")
i = 1

'loops through each file in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
    'loops though each child directory
    For Each objSecSubFolder In objSubFolder.subfolders
       'loops though each file
        For Each objFile In objSecSubFolder.Files
            'print file name
            Cells(i + 1, 1) = objFile.Name
            'print file path
            Cells(i + 1, 2) = objFile.Path
            i = i + 1
        Next objFile
    Next objSecSubFolder
Next objSubFolder

End Sub