Trouble searching a Word document from Excel

[Corners]

I’m having trouble. I want to do a “Find and Replace” of a wor
document from a list of files inside an Excel workbook. For example,
have a list of word files, complete with file paths listed in column
(~10 files). In cell A1 I have the test I want to search for, and i
cell A2, I have the text I want to replace it with. I can’t seem t
get the MSWord VBA code to work from inside of Excel. My exce
workbook automatically generates the file list and outputs it to colum
C, but when I want to switch over to MS word VBA code, it won’t work.

Please help

 

[Dave Peterson]

My knowledge of Word macros comes from the recorder. You should be able to make
that portion more efficient. But it did work ok for me.

Close all instances of Word before you start--or excel may not use the right
one!

Option Explicit
Sub doWordChanges()
Dim oWord As Object
Dim myWordDocument As Object

Dim testStr As String
Dim myRng As Range
Dim myCell As Range

Set oWord = Nothing
On Error Resume Next
Set oWord = CreateObject("Word.Application")
On Error GoTo 0

oWord.Visible = True
With Worksheets("sheet1")
Set myRng = .Range("a2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With


For Each myCell In myRng.Cells
If Dir(myCell.Offset(0, 2).Value) = "" Then
MsgBox "File doesn't exist: " & myCell.Offset(0, 2).Value
Else
Set myWordDocument = oWord.Documents.Open _
(Filename:=myCell.Offset(0, 2).Value)
myWordDocument.Select
oWord.Selection.Find.ClearFormatting
oWord.Selection.Find.Replacement.ClearFormatting
With oWord.Selection.Find
.Text = myCell.Value
.Replacement.Text = myCell.Offset(0, 1).Value
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWord.Selection.Find.Execute Replace:=2 'wdReplaceAll
myWordDocument.Close savechanges:=True
End If
Next myCell

oWord.Quit
Set myWordDocument = Nothing
Set oWord = Nothing

End Sub

 

[Corners]

Thank you very much. That helped a lot. Actually, I was wanting to
search in the footer, which required some changes. Here's what I wound
up with (it's not pretty, but it works)...

Option Explicit
Sub doWordChanges()
Dim oWord As Object
Dim myWordDocument As Object

Dim testStr As String
Dim myRng As Range
Dim myCell As Range

Set oWord = Nothing
On Error Resume Next
Set oWord = CreateObject("Word.Application")
On Error GoTo 0

oWord.Visible = True
With Worksheets("sheet1")
Set myRng = .Range("a2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With


For Each myCell In myRng.Cells
If myCell.Offset(0, 2).Value = "" Then
'MsgBox "File doesn't exist: " & myCell.Offset(0, 2).Value
Else
Set myWordDocument = oWord.Documents.Open _
(Filename:=myCell.Offset(0, 2).Value)
myWordDocument.Select

oWord.Selection.Find.ClearFormatting
oWord.Selection.Find.Replacement.ClearFormatting

Dim myStoryRange As Word.Range

For Each myStoryRange In myWordDocument.StoryRanges

With myStoryRange.Find
..Text = myCell.Value
..Replacement.Text = myCell.Offset(0, 1).Value
..Forward = True
..Wrap = 1 'wdFindContinue
..Format = False
..Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With
Next

myWordDocument.Save
myWordDocument.Close savechanges:=True

End If
Next myCell

oWord.Quit
Set myWordDocument = Nothing
Set oWord = Nothing

End Sub

 

[Dave Peterson]

If it works in Word, it's beautiful!!!!

Thank you very much. That helped a lot. Actually, I was wanting to
search in the footer, which required some changes. Here's what I wound
up with (it's not pretty, but it works)...

<<snipped>>