Macro or method to find and replace words in microsoft word

[Drover123]

Hi,

Does anyone know of a macro that I can use to find and replace words in multiple ms word files? I have about 192 word documents in a folder.

Regards,

Michael

[Paul_Hossler]

This is the main module, the Doc has two utility modules that I use

(Hmm - for some reason I can't upload -- getting message that the 72kb .Doc 'Exceeds your quote by 2.45MB ... Sum of all attachments owned ... 3.33 MB". If you're interested, I'll just paste in the utility code using VBA tags)

Seems to work OK, but there are some things about it I don't like, but haven't figured out how to resolve

1. Macro uses InputBox to get the .Find and the .Replace text. I tried to use Application.Dialogs (wdDialogEditReplace) to remember the other options in the first doc, and then re-apply them to the following docs, but couldn't get it to work the way I wanted

2. Even with ScreenUpdating = False, there is more screen flash than I'd like

Maybe someone else has some ideas



Option Explicit
Option Compare Text
Const sModule As String = "Search and Replace All Documents in a Folder"
Public aFiles() As String
'Deliberatly made so only single folder is used -- IMHO, it's safer ... for the user
Sub MultiDocumentReplace()
Dim iFile As Long
Dim sFolder As String
Dim sOldText As String, sNewText As String
Dim oDocument As Document

'tell user what's coming up
If MsgBox( _
"1. This will allow you to select a folder to be processed" & vbCrLf & vbCrLf & _
"2. All .Doc, .Dot, .Docx, and .Dotx files will be opened, and your" & vbCrLf & _
" Search and Replace processed" & vbCrLf & vbCrLf & _
"3. Press 'No' to exit" & vbCrLf & vbCrLf & vbCrLf & _
"Do you want to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, sModule) = vbNo Then
Exit Sub
End If

'set initial to Documents
sFolder = RegSpecialFolder(cMyDocuments)

'get the folder or exit
sFolder = ChooseFolder(sFolder)
If sFolder = "" Then Exit Sub


'build list of files
On Error Resume Next
Erase aFiles
On Error GoTo 0

'remember to start at 1, not LBound, later on, but we need to ReDim after Erase
ReDim aFiles(0)

Call BuildListOfFiles(aFiles, sFolder, "*.DOC")
Call BuildListOfFiles(aFiles, sFolder, "*.DOT")
'see if there are any files, exit if not
If UBound(aFiles) = 0 Then
Call MsgBox( _
"Sorry -- there does not seem to be any Doc or Dot files in '" & sFolder & "'", _
vbInformation + vbOKOnly, sModule)
Exit Sub
End If

'get the old text to be replaced
sOldText = InputBox("What is the old text that you want to replace?", sModule)
If Len(sOldText) = 0 Then Exit Sub

'get the new text to replace
sNewText = InputBox("What is the text that you want to replace '" & sOldText & "' with?", sModule)
If Len(sNewText) = 0 Then Exit Sub


'turn off screen updating
Application.ScreenUpdating = False


'open each file, Replace text, save
For iFile = 1 To UBound(aFiles)
Call pvtFindReplaceOneFile(sFolder & "\" & aFiles(iFile), sOldText, sNewText)
Next iFile

'turn on screen updating
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Private Sub pvtFindReplaceOneFile(sFile As String, sOld As String, sNew As String)
Dim oDocument As Document
Application.StatusBar = "Replacing in " & sFile

Documents.Open (sFile)

Set oDocument = ActiveDocument
With oDocument.Content.Find
.Text = sOld
.Replacement.Text = sNew
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Options.SavePropertiesPrompt = False

Call oDocument.Save
Call oDocument.Close

Set oDocument = Nothing
End Sub






Paul

[Drover123]

Thanks Paul. I'll give this a whirl today and feedback.

Cheers

[fumei]

"Does anyone know of a macro that I can use to find and replace words in multiple ms word files?"

It seems to be this has got to be clarified in more detail.

Are you finding and replacing the same text for each document?

Are you finding only one, or many, or all, instances of the found text?

Do you require and method of inputting the search string, or do you know it? In other words, do you need the inputboxes?

Do you need a folder selection method? I notice Paul is using what appears to be a function: ChooseFolder(sFolder)

No code for it posted.

IF it is a simple replace operation - for example, changing every instance of a text string - then it really is simple.

Say you have a bunch of documents (sure, 192 in the same known folder) with a company name of:

YaddaYadda Software Inc.

And you want to change it to YaddaYadda FANTASTIC Software Inc.

So basically, simple but multiple text replacement. You could do it like:
Sub ReplaceLots()
Dim file
Dim path As String
path = "c:\Blah\ThisFolder\"
' note the "\"

file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open Filename:=path & file
With ActiveDocument
With .Range.Find
.Text = "YaddaYadda Software Inc."
.Replacement.Text = "YaddaYadda FANTASTIC Software Inc."
.Execute Replace:=wdReplaceAll
End With
.Save
.Close
End With
file = Dir()
Loop
End Sub


Done. ALL instances of "YaddaYadda Software Inc.", in ALL the .doc files in the folder will be changed to "YaddaYadda FANTASTIC Software Inc."

[fumei]

Paul, could you explain:
'remember to start at 1, not LBound, later on, but we need to ReDim after Erase
ReDim aFiles(0)

Call BuildListOfFiles(aFiles, sFolder, "*.DOC")
The routine BuildListOfFiles is not posted, and I am not sure what it does.

Why are you building a list of files. What is the purpose of this apparent array?

[Paul_Hossler]

(Hmm - for some reason I can't upload -- getting message that the 72kb .Doc 'Exceeds your quote by 2.45MB ... Sum of all attachments owned ... 3.33 MB". If you're interested, I'll just paste in the utility code using VBA tags)


Hmm - now it will let me upload a document

I couldn't upload the .Doc for some reason, and I didn't want to paste in 100's of line of VBA if the OP wasn't interested. I used 2 of my 'tool box' modules, one that captures the Registry subs and functions, and one that builds an array of file names (which is the one you were asking about). (below)

My 'stlye' is to have a number of general purpose toolbox or utility modules in a Toolbox.doc. I just drag the modules I need into a new project.

When I need to improve (or fix) a toolbox function, I only need to do it in one place. Still have to update the various projects that use the module, but that's easier. I'd use an add-in except my users tend to be in the 95% group that uses 5% of the capability)


Option Explicit
'allows user to select folder
Function ChooseFolder(Optional sInitFolder As String = "", _
Optional Title As String = "Select Folder or Cancel to Exit", _
Optional ButtonLabel As String = "Select Folder") As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.ButtonName = ButtonLabel
.InitialFileName = sInitFolder
.Title = Title
If .Show = -1 Then
ChooseFolder = .SelectedItems(1)
Else
ChooseFolder = ""
End If
End With
Set fd = Nothing
End Function

'build list on files, or add to existing list
Sub BuildListOfFiles(ByRef vList() As String, sPath As String, sMask As String)
Dim sFile As String
Dim n As Long

sFile = Dir(sPath & "\" & sMask)

n = UBound(vList)

While sFile <> ""
n = n + 1
ReDim Preserve vList(n)

vList(n) = sFile

sFile = Dir()
Wend
End Sub





Paul

[lucas]

The upload problem should be resolved. Please let me know if anyone has any further problems.

[Paul_Hossler]

The upload problem should be resolved. Please let me know if anyone has any further problems


Thanks -- doesn't take much to confuse me sometimes, and that was a head-scratcher

Paul