You won't be able to use FileSearch, it no longer works with Office 2007 on.
This will be adaptable for your needs. It's written for Excel, but should work in Word
'---------------------------------------------------------------------------------------
' Author : Roy Cox (royUK)
' Website : for more examples and Excel Consulting
' Date : 08/06/2011
' Purpose : Copy specific cells from all workbooks ina directory
'---------------------------------------------------------------------------------------
Option Explicit
Sub CombineData()
Dim oWbk As Workbook
Dim uRng As Range
Dim rNextRw As Long
Dim sFil As String
Dim sPath As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
' On Error GoTo exithandler 'add this back after testing
'enter full path here
'this assumes a Data folder in this workbook's folder
sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"
ChDir sPath
sFil = Dir("*.xls") 'change or add formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through
With ThisWorkbook.Worksheets(1)
Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil) 'opens the file
rNextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Range("b11").Copy .Cells(rNextRw, 1) 'company
ActiveSheet.Range("b12").Copy .Cells(rNextRw, 2) 'contact
'etc
End With
oWbk.Close False 'close source workbook
sFil = Dir
Loop
exithandler:
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Bookmarks