Solved: Search files and count occurrences of a string

[clhare]

I am trying to create a macro that will search all folders and subfolders and count the number of times a specific string of text is found. Here's the macro I am working on. Currently it seems like all is working good until I get to the part that is actually supposed to check for the string (the "DoWork" procedure). What am I doing wrong?

Option Explicit
Public scrFso As Object 'a FileSystemObject
Public scrFolder As Object 'the folder object
Public scrSubFolders As Object 'the subfolders collection
Public scrFile As Object 'the file object
Public scrFiles As Object 'the files object
Public blnFound As Boolean
Public strStartPath As String
Public strPhrase1 As String
Public strPhraseOccurrences1 As Integer
Public strFilesChecked1 As Integer
Public GetFile

Sub OpenAllTemplateFilesInSubFolders()

Dim strStartPath As String
Dim GetFile

' Assign or get values for variables
strStartPath = InputBox("Enter path to open.")
strStartPath = strStartPath & "\"
strPhrase1 = "100 Main Road"
' Indicate where to get the files
GetFile = Dir(strStartPath & "\" & "*.dot")
'stop the screen flickering
Application.ScreenUpdating = False

'open the files in the start folder
OpenAllTemplateFiles strStartPath
'search the subfolders for more files
SearchTemplateSubFolders strStartPath

'turn updating back on
Application.ScreenUpdating = True

MsgBox "The old address was found " & strPhraseOccurrences1 & " times in " & strFilesChecked1 & " files.", _
Buttons:=vbInformation + vbOKOnly
End Sub

Sub OpenAllTemplateFiles(strPath As String)

Dim strName As String
Dim wdDoc As Document
If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.getfolder(strPath)
For Each scrFile In scrFolder.Files
' The name of this file
strName = scrFile.Name
' The status bar is just to let us know where we are
Application.StatusBar = strPath & "\" & strName
' We'll open the file fName only if it is a template
If Right(strName, 4) = ".dot" Then
Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _
ReadOnly:=False, Format:=wdOpenFormatAuto)
' Count number of files being checked
strFilesChecked1 = strFilesChecked1 + 1

'Call the macro that performs work on the file and pass a reference to it
DoWork wdDoc
'we close saving changes
wdDoc.Close wdSaveChanges
End If
Next
' Return control of status bar to Word
Application.StatusBar = False
End Sub

Sub SearchTemplateSubFolders(strStartPath As String)

If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each scrFolder In scrSubFolders
Set scrFiles = scrFolder.Files
' If there are files below, call openFiles to open them
If scrFiles.Count > 0 Then
OpenAllTemplateFiles scrFolder.Path
End If
' Call ourselves to see if there are subfolders below
SearchTemplateSubFolders scrFolder.Path
Next
End Sub

Sub DoWork(wdDoc)

' Search for and count occurrences of the text typed
With ActiveDocument.Content.Find
Do While .Execute(findtext:=strPhrase1, Forward:=True, Format:=True, _
MatchWholeWord:=True) = True
' Display message in Word's Status Bar
StatusBar = "Marco is processing. Please wait . . . " & _
Chr$(34) & strPhrase1 & Chr$(34) & "."
strPhraseOccurrences1 = strPhraseOccurrences1 + 1
Loop
End With
' Release control of the status bar when done
Application.StatusBar = False
End Sub
Any help is greatly appreciated!

[gmaxey]

Fundamentally I don't see anything wrong with your DoWork procedure. It works with the following test:

Sub Test()
Dim lngCount As Long
Dim wdDoc As Word.Document
Set wdDoc = ActiveDocument
DoWork wdDoc, lngCount
MsgBox lngCount
End Sub
Sub DoWork(wdDoc As Word.Document, lngCount As Long)

' Search for and count occurrences of the text typed
With ActiveDocument.Content.Find
Do While .Execute(findtext:="100 Main Road", Forward:=True, Format:=True, _
MatchWholeWord:=True) = True
' Display message in Word's Status Bar
StatusBar = "Marco is processing. Please wait . . . " & _
Chr$(34) & strPhrase1 & Chr$(34) & "."
lngCount = lngCount + 1
Loop
End With
' Release control of the status bar when done
Application.StatusBar = False
End Sub

It will only search the main test story though.

[Frosty]

Couple comments.

1. I would strongly advocate you using prefixes to denote not just data type of a variable (strPhrase1 for the string variable) but also the variable scope. Since strPhrase1 is a public module level, you might call it "p_strPhrase1" -- or if it is only needed to be used in this module only, you might change it to a Private variable to the module, and prefix with "m_strPhrase1"

This makes your code easier to read, and gets you out of running circles to make sure everything is working well (for example, why does strPhraseOccurences1 have a prefix of "str" when it is an integer data type?)

2. Always type your variables. Your wdDoc variable is typed as a document object, your parameter for DoWork is not... your declaration for that sub routine should be
Sub DoWork (wdDoc As Document)

3. Why are you using ActiveDocument in a routine where you have passed the very document you want to be working on? A causal glance at your code seems like this should still work (since you're not opening the document with the .Visible set to False) but it still seems strange).

4. If you are able to accurate cycle through all of your documents, then the only routine you really care about is the DoWork routine. That is the one that is failing. It is a relatively simple concept in routine. You want to search a document object for a particular phrase, and if it is found... you will increment a counter up as many times as it is found in the passed document). Rather than have this be a Subroutine, you should set this up as a function which returns the number of occurences of a phrase within a document... so you would redeclare this function thusly:
Public Function fGetNumOccurencesOfPhrase (wdDoc As Document, strSearchPhrase As String) As Integer

Can you work on this new function fGetNumOccurencesOfPhrase (or whatever you want to call it, but keep the structure the same), and then let us know what problems you have?

Your coding is getting better and better, Cheryl-- I think this will be a good exercise. I don't see anything off the top of my head, but I haven't actually run your code.

[Frosty]

One last comment... your use of strPhraseOccurences1 as a public variable means that the lifetime of that variable is the duration of the application object. That may sound like nonsense. But in practical application-- you're not resetting that counter to 0 when you start your routine (that I can see), which means (assuming everything else is working) it will only be accurate the first time you run this routine when you've first opened Word.

[clhare]

Ok, I have changed the DoWork procedure to the following and it still gets hung up when it tries to execute the Do loop.

Sub DoWork(wdDoc As Document, lngPhraseOccurrences1 As Long)
' Search for and count occurrences of the text typed
With wdDoc.Content.Find
Do While .Execute(findtext:=strPhrase1, Forward:=True, Format:=True, _
MatchWholeWord:=True, Wrap:=wdFindContinue) = True
' Display message in Word's Status Bar
StatusBar = "Marco is processing. Please wait . . . " & _
Chr$(34) & strPhrase1 & Chr$(34) & "."
lngPhraseOccurrences1 = lngPhraseOccurrences1 + 1
Loop
End With

' Release control of the status bar when done
Application.StatusBar = False
End Sub
I will try to do something with the function instead, but searches and have always been confusing to me as there seems to be so many different ways to do them. I haven't done much with functions at all. I've been trying to find some examples to get me started, but they all seem to be for Excel.

[fumei]

"it still gets hung up when it tries to execute the Do loop"

Can you elaborate? Word freezes?? You can some error message?

[Frosty]

Cheryl,

I think something like this would work better... I don't think you need some of the find parameters you're using.

Public Function fGetNumPhrasesIn(oDoc As Document, sPhrase As String) As Integer
Dim rngSearch As Range
Dim iRet As Integer

Set rngSearch = oDoc.Content

With rngSearch.Find
.Text = sPhrase
.MatchWholeWord = True
Do While .Execute = True
iRet = iRet + 1
Loop
End With
fGetNumPhrasesIn = iRet
End Function

You can add in status bar stuff to it if you want, but since you're not adjusting anything in the actual loop (i.e., "Found 1" changing to "Found 2" etc), you would only want to update the status bar outside of that loop...

[macropod]

Change:
Wrap:=wdFindContinue
to:
Wrap:=wdFindStop

[clhare]

Whether I use the DoWork procedure or the fGetNumPhrasesIn function, the macro stops when it hits the Do loop and I get runtime error 4605 which says "this command is not available".

[macropod]

Try this approach:
Sub OpenAllTemplateFiles(strPath As String)

Dim strName As String
Dim wdDoc As Document
If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.getfolder(strPath)
For Each scrFile In scrFolder.Files
' The name of this file
strName = scrFile.Name
' The status bar is just to let us know where we are
Application.StatusBar = strPath & "\" & strName
' We'll open the file fName only if it is a template
If Right(strName, 4) = ".dot" Then
Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _
ReadOnly:=True, Format:=wdOpenFormatAuto)
' Count number of files being checked
strFilesChecked1 = strFilesChecked1 + 1
strPhraseOccurrences1 = strPhraseOccurrences1 + UBound(Split(wdDoc.Range.Text, strPhrase1))
'we close saving changes
wdDoc.Close
End If
Next
' Return control of status bar to Word
Application.StatusBar = False
End Sub
The only limitation is that the test is case-sensitive. If that's an issue, you could change:
UBound(Split(wdDoc.Range.Text, strPhrase1))
to"
UBound(Split(LCase(wdDoc.Range.Text), LCase(strPhrase1)))

[Frosty]

That's a really interesting idea, Paul. But I'm not sure why a different approach would solve the problem. Why is the find command not available?

Cheryl, when you step through the code, on what exact line does it stop and give that message? What state is word in? What kind of documents are you opening?

Can you try removing some of your parameters when performing the open in the document (like the format parameter). Or are these .dot files using document protection in some fashion? It doesn't make send that the .Find isn't available without you giving us some more info...

[clhare]

It works now with Paul's code.

With the other version, I get error 4605 (this command is not available) as soon as it hits the Do Loop. I am running the macro on Word templates. I'm not sure what you mean by the state Word is in. Some templates are protected, which is why earlier on I check for that and unprotect if it is. Then at the end I protect it again.

Now that it's working, I tried adding to it so I could replace the old address with the new address, but I get error 4605 again as soon as it hits the Do Loop below. (I also tried a regular search/replace but got the error on the .Execute, so it seems like maybe .Execute is the sticking point rather that the loop itself.)

Set rngMyRange = wdDoc.Range
With rngMyRange.Find
Do While .Execute(FindText:="100 Half Day Road", _
Forward:=True) = True
rngMyRange.Text = "4 Overlook Point"
rngMyRange.Collapse 0
Loop
End With

[Frosty]

Where are you checking for document protection in your code? If some if these templates have document protection, you will need to address it, and I don't see where you're doing that.

I really didn't look too deeply at your methodology for iterating through all of your folders and subfolders... It has limitations since you aren't doing it recursively, but you said it's working to get you to all the files you need. At which point, we just have to address handling those files.

It might be better to simply pass the actual path of the document you want to search, rather than the document itself, so that your DoWork or GetInfoAbout functionality can be separate from you generation of the list of files you want to get.

When I ask what state is word in, I'm wondering what it looks like when you step through this code and it fails. Does it fail on every document? Only some? You have to try and specify why it would fail and when... Or provide document attachments that it fails on

[clhare]

Oops! Lost that part at some point... I've added it back in, switched to the easy way of replacing text, and added Paul's code in a second time to count occurrences of the new address so I can make sure all matches. It works great now!! I am so excited! Here's what I've ended up with. If there's a cleaner way to do the search, let me know!

Option Explicit
Public scrFso As Object 'a FileSystemObject
Public scrFolder As Object 'the folder object
Public scrSubFolders As Object 'the subfolders collection
Public scrFile As Object 'the file object
Public scrFiles As Object 'the files object
Public blnFound As Boolean
Public strStartPath As String
Public strPhrase1 As String
Public lngPhraseOccurrences1 As Long
Public strPhrase2 As String
Public lngPhraseOccurrences2 As Long
Public lngFilesChecked As Long
Public GetFile
Sub OpenAllTemplateFilesInSubFolders()
' THIS MACRO IS USED TO OPEN .DOT FILES ONLY IN SELECTED FOLDER AND SUBFOLDERS

Dim strStartPath As String
Dim GetFile

' Assign or get values for variables
strStartPath = InputBox("Enter path to open.")
strStartPath = strStartPath & "\"
strPhrase1 = "100 Briarcliff Road"
strPhrase2 = "4 Center Plaza"
' Indicate where to get the files (both documents and templates)
GetFile = Dir(strStartPath & "\" & "*.*")
' Set starting values
blnFound = False
lngPhraseOccurrences1 = 0
lngPhraseOccurrences2 = 0
lngFilesChecked = 0
' Stop the screen flickering
Application.ScreenUpdating = False

' Open the files in the start folder
OpenAllTemplateFiles strStartPath
' Search the subfolders for more files
SearchTemplateSubFolders strStartPath

' Turn updating back on
Application.ScreenUpdating = True

' Display a results message
MsgBox "The old address was found " & (lngPhraseOccurrences1) & " times in " & lngFilesChecked & " files." & _
vbNewLine & "The new address was found " & (lngPhraseOccurrences2) & " times.", _
Buttons:=vbInformation + vbOKOnly
End Sub
Sub OpenAllTemplateFiles(strPath As String)

Dim strName As String
Dim wdDoc As Document
Dim rngStory As Range
Dim LockState As Boolean
'Dim rngMyRange As Range
If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.getfolder(strPath)
For Each scrFile In scrFolder.Files
' The name of this file
strName = scrFile.Name
' The status bar is just to let us know where we are
Application.StatusBar = strPath & "\" & strName
' We'll open the file fName only if it is a template
If (Right(strName, 4) = ".dot") Or (Right(strName, 4) = ".doc") Then
Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _
ReadOnly:=True, Format:=wdOpenFormatAuto)

With ActiveDocument
' Unprotect the document
If .ProtectionType = wdNoProtection Then
LockState = False
Else
.Unprotect
LockState = True
End If

' ******************************************************************
' STEP 1: COUNT NUMBER OF FILES CHECKED AND NUMBER OF OCCURRENCES
' ******************************************************************
' Count number of files being checked
lngFilesChecked = lngFilesChecked + 1
' Count number of occurrences of phrase in document (not case sensitive)
lngPhraseOccurrences1 = lngPhraseOccurrences1 + UBound(Split(LCase(wdDoc.Range.Text), LCase(strPhrase1)))

' ******************************************************************
' STEP 2: NOW MAKE THE UPDATES
' ******************************************************************
' Search are replace field text
For Each rngStory In wdDoc.StoryRanges
With rngStory.Find
.Text = "100 Briarcliff Road"
.Replacement.Text = "4 Center Plaza"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.MatchCase = True
End With
With rngStory.Find
.Text = "100 BRIARCLIFF ROAD"
.Replacement.Text = "4 CENTER PLAZA"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.MatchCase = True
End With
Next rngStory

' ******************************************************************
' STEP 3: COUNT NUMBER OF OF OCCURRENCES OF NEW TEXT
' ******************************************************************
' Count number of occurrences of phrase in document (not case sensitive)
lngPhraseOccurrences2 = lngPhraseOccurrences2 + UBound(Split(LCase(wdDoc.Range.Text), LCase(strPhrase2)))

' If changes were found (and made)
If blnFound = True Then
' Relock document if originally locked
If LockState = True Then
.Protect wdAllowOnlyFormFields
End If
' Save and close file
.Close savechanges:=wdSaveChanges
ElseIf blnFound = False Then
' Close file without saving
.Close savechanges:=wdDoNotSaveChanges
End If
End With
End If
Next
' Return control of status bar to Word
Application.StatusBar = False
End Sub
Sub SearchTemplateSubFolders(strStartPath As String)
If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each scrFolder In scrSubFolders
Set scrFiles = scrFolder.Files
' If there are files below, call openFiles to open them
If scrFiles.Count > 0 Then
OpenAllTemplateFiles scrFolder.Path
End If
' Call ourselves to see if there are subfolders below
SearchTemplateSubFolders scrFolder.Path
Next
End Sub

[clhare]

When the macro was failing, the very first file was open. That's as far as it got.

Also, I just checked, and the code to replace the text with new text isn't working. I don't get an error, but no text replacement is made.

[Frosty]

Now that I reread your latest code, I see that you are using a recursive approach. Your commenting is very clear, and that's a good thing.

Your naming conventions could still use some work. And your use of the Public variable as your main data holder is going to cause you to have an inaccurate count if you use the same word session to run this macro subsequent times.

But other than that, glad it's working!

[clhare]

Actually, it's not replacing the text. Any suggestions for that?

Also, what would be a better way to handle the public variable?

[Frosty]

So... It's not working. Well, you're mixing up your methodologies again... You have a massive With ActiveDocument block, but you also use a wdDoc variable.

This is a really good lesson in modularizibg your code. There are many ways to do this, but at the end of the day... You should structure your code so you can either pass a subroutine the document object you're going to do stuff with, or a path to the document you want to do stuff with.

Having it in one big routine makes you more error prone in writing the code (like using ActiveDocument when you mean wdDoc, and forgetting about document protection issues), and harder to diagnose actual code failures, because stepping through recursive code is a headache.

[Frosty]

As for public variables... I would suggest not using them and passing parameters instead. Also, add a "pub" or "p_" or "pub_" in front of all of them.

You can also reset them all at the top of your routine to the starting values you want. Or you can try using Private instead (has a different variable lifetime).

But, on the whole, lifetime and scope are big topics. I would do searches on them and understand them better before using them in your coding. Until then, I would force yourself to use local variables and parameters. It's a bit more labor intensive, but it is much much easier to troubleshoot... It will make you a better programmer because your bugs won't be so mysterious.

[clhare]

I had reset all values for the variables at the start of the routine except the "scr" variables. Do they also need to be reset?

I will study up on passing parameters instead and on scope. I know I am not good at that at all.

[Frosty]

Sorry, you're absolutely right. I'm reading this page on a phone, so I missed that. Read up on scope, but it looks like you're handling the resetting of the variables properly.

as for the scr variables... You can. But you're explicitly setting them (I think) in either for loops or elsewhere. Technically, since you're using CreatObject but never explicitly killing the object... Combined with use of a public variables lifetime, you could have some issues with memory at some point. But if imagine it would take weeks if running the code and never restarting Word.

So, I'm not sure how to approach... Why don't you fix the ActiveDocument/wdDoc mistake, and then try again?

[Frosty]

Oh... It may depend on where the text is that you're replacing. Is it content of a form field? When you reprotect a document without preserving the form field changes, they can reset to defaults. If those defaults are the old addresses, that may result in what you're seeing. But I have no real idea... I can only give you guidance on how to approach and make better code

And to that-- you need to prefix AND type your variables, modularize your code (so that, at least, you go back to your DoWork encapsulation of that code), and then try to step through and see why things aren't working on a specific document. And when they don't work.

[clhare]

Oh... one think I just noticed re Paul's code... even if the text isn't found, the variable is incremented by 1. How could that be fixed so it only increments if the text is found?

[clhare]

Actually, I think that's my fault. In the words of Emily Litella... never mind!

[macropod]

Hi Cheryl,

Try the following:
Option Explicit
Public scrFso As Object 'a FileSystemObject
Public scrFolder As Object 'the folder object
Public scrSubFolders As Object 'the subfolders collection
Public scrFile As Object 'the file object
Public scrFiles As Object 'the files object
Public blnFound As Boolean
Public strStartPath As String
Public strFnd As String
Public strRep As String
Public strPhraseOccurrences1 As Integer
Public strFilesChecked1 As Integer
Public GetFile

Sub OpenAllTemplateFilesInSubFolders()
'stop the screen flickering
Application.ScreenUpdating = False

Dim strStartPath As String
Dim GetFile
' Assign or get values for variables
strStartPath = InputBox("Enter path to open.")
If Right(strStartPath, 1) <> "\" Then strStartPath = strStartPath & "\"
strFnd = "100 Main Road"
strRep = "100 Main Road"
' Indicate where and what kind of files to get
Call GetFolder(strStartPath)

'search the subfolders for more files
SearchTemplateSubFolders strStartPath

' Return control of status bar to Word
Application.StatusBar = False

'turn updating back on
Application.ScreenUpdating = True

MsgBox "The old address was found " & strPhraseOccurrences1 & " times in " & strFilesChecked1 & " files.", _
Buttons:=vbInformation + vbOKOnly
End Sub

Sub SearchTemplateSubFolders(strStartPath As String)

If scrFso Is Nothing Then
Set scrFso = CreateObject("scripting.filesystemobject")
End If
Set scrFolder = scrFso.GetFolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each scrFolder In scrSubFolders
Set scrFiles = scrFolder.Files
' Indicate where and what kind of files to get
Call GetFolder(scrFolder.Path & "\")
' Call ourselves to see if there are subfolders below
SearchTemplateSubFolders scrFolder.Path
Next
End Sub
Sub GetFolder(StrFolder As String)
GetFile = Dir(StrFolder & "*.dot")
'open the files in the folder
While GetFile <> ""
' The status bar is just to let us know where we are
Application.StatusBar = StrFolder & GetFile
' Count number of files being checked
strFilesChecked1 = strFilesChecked1 + 1
Call UpdateTemplates(StrFolder & GetFile)
GetFile = Dir()
Wend
End Sub

Sub UpdateTemplates(GetFile)
Dim strName As String
Dim wdDoc As Document
Dim Rng As Range
' We'll open the file fName only if it is a template
Set wdDoc = Documents.Open(GetFile, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto)
With wdDoc
' Check all potential areas
For Each Rng In .StoryRanges
' Update address count
strPhraseOccurrences1 = strPhraseOccurrences1 + UBound(Split(Rng.Text, strFnd))
' Replace old addresses
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strFnd
.Replacement.Text = strRep
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next
'we close saving changes
.Close wdSaveChanges
End With
' Let Word do its housekeeping
DoEvents
End Sub

[clhare]

Hi Paul,

I would have to check whether the file is locked or not, but in the code above, I'm not sure where to do that. Here's what I was doing:

Dim LockState As Boolean

' Unprotect the document
If .ProtectionType = wdNoProtection Then
LockState = False
Else
.Unprotect
LockState = True
End If
Also, if I wanted to check both .dot and .doc could I do the following?
GetFile = Dir(StrFolder & "*.do*")

[macropod]

You could test/work with the protection, thus:
Sub UpdateTemplates(GetFile)
Dim strName As String
Dim wdDoc As Document
Dim Rng As Range
Prot As Long
Pwd As String
' We'll open the file fName only if it is a template
Set wdDoc = Documents.Open(GetFile, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto)
With wdDoc
If .ProtectionType <> wdNoProtection Then
Prot = .ProtectionType
Pwd = InputBox("Please enter the Password for:" & vbCr & .Name, "Password")
.Unprotect Password:=Pwd
' Check all potential areas
For Each Rng In .StoryRanges
' Update address count
strPhraseOccurrences1 = strPhraseOccurrences1 + UBound(Split(Rng.Text, strFnd))
' Replace old addresses
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strFnd
.Replacement.Text = strRep
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next
If Prot <> wdNoProtection Then
If Prot = wdAllowOnlyFormFields Then
.Protect ProtectionType:=Prot, NoReset:=True, Password:=Pwd
Else
.Protect ProtectionType:=Prot, Password:=Pwd
End If
End If
'we close saving changes
.Close wdSaveChanges
End With
' Let Word do its housekeeping
DoEvents
End Sub
As for processing documents as well, you could use 'GetFile = Dir(StrFolder & "*.do*")', but do be aware there are a few apps that produce files with DOS and DOX extensions.

[clhare]

This is just awesome! There are so many times I could use a macro like this to make updates to all files in a folder (which contains only .dot and .doc files). Thank you all so much!!

[clhare]

Just noticed something.... the macro doesn't count the phrase if it has a required space in it. How do I make sure those instances are also included in the count?

[gmaxey]

Cheryl,

Maybe it is lost in the chaff, but where do you actaully use/return the count? It appears that you are trying to find and replace a phrase in multiple documents. No? What is the purpose of the count?

Have you looked at: http://gregmaxey.mvps.org/word_tip_pages/vba_find_and_replace.html

[macropod]

the macro doesn't count the phrase if it has a required space in it.
What is "a required space"? The macro finds whatever you pass to it - not something that may or may not be match the search criteria.

[Frosty]

I'm guessing it's a "hard space" (CTRL+SPACEBAR).

You can use the code "^w" in place of any spaces you have in the find text string, as long as you're not performing a wildcard search. That should find both a regular space and a hard space.

[macropod]

Try the following code revision:
Sub UpdateTemplates(GetFile)
Dim strName As String, wdDoc As Document
Dim Rng As Range, Prot As Long, Pwd As String
' Open the file GetFile
Set wdDoc = Documents.Open(GetFile, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto)
With wdDoc
' Test & process document protection
Prot = .ProtectionType
If .ProtectionType <> wdNoProtection Then
Pwd = InputBox("Please enter the Password for:" & vbCr & .Name, "Password")
.Unprotect Password:=Pwd
End If
' Check all potential areas
For Each Rng In .StoryRanges
' Update address count
strPhraseOccurrences1 = strPhraseOccurrences1 + UBound(Split(Replace(Rng.Text, Chr(160), Chr(32)), strFnd))
' Replace old addresses
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Text = strFnd
.Replacement.Text = strRep
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next
' Reprotect document, if applicable
If Prot <> wdNoProtection Then
If Prot = wdAllowOnlyFormFields Then
.Protect Type:=Prot, NoReset:=True, Password:=Pwd
Else
.Protect Type:=Prot, Password:=Pwd
End If
End If
' Close, saving changes
.Close wdSaveChanges
' Let Word do its housekeeping
DoEvents
End With
End Sub

[Frosty]

Paul-- won't that fail to find regular spaces? chr(160) is a hard space, and chr(32) is a regular space.

It seems like you either have to search for both, or replace all chr(32) and chr(160) with the string "^w" before you pass it to the find object...

[macropod]

With the revised construction it'll find both.

What I'm trying to avoid is the overhead associated with running the Find/Replace as a loop just for the purposes of getting a count.

[clhare]

I want it to count occurrences just so I can see how many times the macro needed to make the change. By having this count in there, I realized that the macro was resaving the file even if the search string wasn't found.

Can the macro be updated to save the file only if the search string is actually found?

[macropod]

As coded, if there haven't been any changes, the file won't be updated.

[dantzu]

Thanks for the topic.