Solved: Search files and count occurrences of a string

[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:
[VBA]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[/VBA]

[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:

[vba]Dim LockState As Boolean

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

[macropod]

You could test/work with the protection, thus:
[VBA]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[/VBA]
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_p...d_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:
[vba]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[/vba]

[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.