running a macro on a list of files

[smh]

Hi, I need help running a macro on various word documents using a list of the file paths/names.
I have two .xls files - one with the macro (which I got off this forum, I think) and some text in two columns. The macro currently opens a specific word document, finds text from column A, and replaces it with text in column B. Instead of opening the specific word document and performing the find/replace, I want it to go through a list of about 400 documents and do the same thing. The paths/filenames of the documents are listed in a separate .xls file. Here is the macro:
Sub conversion()

Dim WordApp As Object
Dim DocWord As Word.Document
Set WordApp = CreateObject("Word.Application")
Set DocWord = WordApp.Documents.Open("C:\Files\Document.doc")
Set myRange = DocWord.Content

myRange.Find.Execute FindText:=Cells(2, 1), ReplaceWith:=Cells(2, 2).Text, _
Replace:=wdReplaceAll
myRange.Find.Execute FindText:=Cells(3, 1), ReplaceWith:=Cells(3, 2).Text, _
Replace:=wdReplaceAll
myRange.Find.Execute FindText:=Cells(4, 1), ReplaceWith:=Cells(4, 2).Text, _
Replace:=wdReplaceAll

DocWord.Close True
Set DocWord = Nothing
Set WordApp = Nothing
End Sub

If anyone could help I would be ever so grateful. Thank you!

 

[smh]

Anybody? Re: running a macro on a list of files

Pretty please?

 

[Bob Rooney]

Try something like the following...

Sub ProcessFiles()
Dim wkbk As Workbook, wks As Worksheet, i As Long, LR As Long, strFile As String
    
With Excel.Application
    Set wkbk = .Workbooks("Book1")
    Set wks = wkbk.Sheets(Sheet1.Name)
End With

With wks
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To LR
        strFile = .Cells(i, 1) & .Cells(i, 2)
        Call conversion(strFile)
    Next i
End With


End Sub



Sub conversion(ByVal strFileFullName As String)
Dim actWkb As Workbook, actSht As Worksheet, i As Long

Dim WordApp As Object
Dim DocWord As Word.Document
Set WordApp = CreateObject("Word.Application")
Set DocWord = WordApp.Documents.Open(strFileFullName)
Set myRange = DocWord.Content

Set actWkb = ThisWorkbook
Set actSht = actWkb.ActiveSheet

With myrng
    For i = 2 To 4
        .Find.Execute FindText:=actSht.Cells(i, 1), ReplaceWith:=actSht.Cells(i, 2).Text, Replace:=wdReplaceAll
    Next i
End With

DocWord.Close True
Set DocWord = Nothing
Set WordApp = Nothing
End Sub

 

[smh]

Hi Bob, thank you so much for helping me. This looks like it will do exactly what I want. Would you be so kind as to let me know what I have to replace to tell it to look in the file where the doc names are listed? I know there must be something I need to change, because I get Run Time Error '9' - Subscript out of Range.

Many thanks!
SMH

 

[smh]

Never mind my last question. I figured it out. Thank you!