Challenge to VBA masters (VBA to find and replace and save and close files)

show what Range/cell in Excel or what page number

- Do you want the find to be case sensitive?

Could your search strings ever be part of a larger string that you don't want to replace?  For example, you want to look for "5415", but what if the string "54159" existed in the file.  Would you want the first 4 characters of that replaced, ending up with "41549"?

There are no page numbers in a word file until you print it (or view in a paginated mode), so not sure you can report that.

Do you want to overwrite the original files, or place the updated copies someplace else?

Could the Excel (or Word) file ever be password protected, and if so how do you want to deal with that?

Private Sub cmdWordSearch_Click()
'Created by Helen Feddema 5-Jun-2014
'Last modified by Helen Feddema 17-Aug-2014

On Error GoTo ErrorHandler

   Dim docSearch As Word.Document
   Dim fso As New Scripting.FileSystemObject
   Dim intFindCount As Integer
   Dim strFindText As String
   Dim strTable As String
   
   'Check that a word or phrase has been entered
   Set txt = Me![txtSearchPhrase]
   strFindText = Nz(txt.Value)
   strTable = "tblWordSearch"
   
On Error Resume Next
   
   DoCmd.Close acTable, strTable
   
On Error GoTo ErrorHandler

   strSQL = "DELETE * FROM " & strTable
   CurrentDb.Execute strSQL, dbFailOnError
   
   If strFindText = "" Then
      strTitle = "No search phrase entered"
      strPrompt = "Please enter a search word or phrase"
      MsgBox prompt:=strPrompt, _
         Buttons:=vbInformation + vbOKOnly, _
         Title:=strTitle
      txt.SetFocus
      GoTo ErrorHandlerExit
   End If
   
   intChoice = Nz(Me![fraSearchPhrase].Value, 1)
   Set appWord = GetObject(, "Word.Application")
   appWord.Visible = False
   Call CloseAllWordDocs

   If intChoice = 1 Then
      'Select a Word document or template to process
      'Create a FileDialog object as a File Picker dialog box.
      Set fd = Application.FileDialog(msoFileDialogFilePicker)
      
      With fd
         .AllowMultiSelect = False
         .Title = "Browse for a Word document or template"
         .ButtonName = "Select"
         .Filters.Clear
         .Filters.Add Description:="Document or template", _
            Extensions:="*.doc; *.docx; *.docm; *.dot; *.dotx; *.dotm", _
            Position:=1
         .InitialView = msoFileDialogViewDetails
         If .Show = -1 Then
            'Get selected item in the FileDialogSelectedItems collection
            For Each varSelectedItem In .SelectedItems
               strFileNameAndPath = CStr(varSelectedItem)
            Next varSelectedItem
         Else
            Debug.Print "User pressed Cancel"
            strFileNameAndPath = ""
            GoTo ErrorHandlerExit
         End If
      End With
      
      Debug.Print "Selected Word doc: " & strFileNameAndPath
      
      Set docSearch = appWord.Documents.Open(strFileNameAndPath)
      docSearch.Select
      intFindCount = 0
      
      With appWord.Selection.Find
         .ClearFormatting
         .Execute findtext:=strFindText
         While .Found = True
            intFindCount = intFindCount + 1
            .Execute
         Wend
      End With
      
      'MsgBox "Found " & intFindCount & " instances of " & strFindText
      Set rst = CurrentDb.OpenRecordset(strTable)
      
      With rst
         .AddNew
         ![DocumentName] = strFileNameAndPath
         ![SearchPhrase] = strFindText
         ![FindCount] = intFindCount
         .Update
      End With
      
      docSearch.Close savechanges:=wdDoNotSaveChanges
      
   ElseIf intChoice = 2 Then
      'Select a folder of documents to process
      'Create a FileDialog object as a Folder Picker dialog box
      lngSelectCount = 0
      Set fd = Application.FileDialog(msoFileDialogFolderPicker)
      
      With fd
         .Title = "Browse for folder containing Word documents to process"
         .ButtonName = "Select"
         .InitialView = msoFileDialogViewDetails
         .InitialFileName = strPath
         If .Show = -1 Then
            strPath = CStr(fd.SelectedItems.Item(1))
            Debug.Print "Selected folder: " & strPath
            Set fld = fso.GetFolder(strPath)
         Else
            strPath = ""
            GoTo ErrorHandlerExit
         End If
      End With
      
      lngSelectCount = fld.Files.Count
      Debug.Print "Number of files in folder: " & lngSelectCount
      strProgressBarText = "Processing documents... "
      Call SysCmd(acSysCmdInitMeter, strProgressBarText, _
         lngSelectCount)
      lngCount = 0
      
      For Each fil In fld.Files
         'Debug.Print "Examining " & fil.Name
         'Debug.Print "Contains 'Copy'? " & Nz(InStr(fil.Name, "Copy"))
         'Debug.Print "1st character: " & Left(fil.Name, 1)
         
         If (Right(fil.Name, 3) = "doc" Or Right(fil.Name, 4) = "docx" _
            Or Right(fil.Name, 3) = "dot" Or Right(fil.Name, 4) = "dotx") _
            And (Left(fil.Name, 1) <> "~" _
            And Nz(InStr(fil.Name, "Copy")) = 0) Then
            strFileNameAndPath = strPath & "\" & fil.Name
            Debug.Print "File to process: " & strFileNameAndPath
            Set docSearch = appWord.Documents.Open(strFileNameAndPath)
            docSearch.Select
            intFindCount = 0
            
            With appWord.Selection.Find
               .ClearFormatting
               .Execute findtext:=strFindText
               While .Found = True
                  intFindCount = intFindCount + 1
                  .Execute
               Wend
            End With
            
            'MsgBox "Found " & intFindCount & " instances of " & strFindText
            Set rst = CurrentDb.OpenRecordset(strTable)
            
            With rst
               .AddNew
               ![DocumentName] = strFileNameAndPath
               ![SearchPhrase] = strFindText
               ![FindCount] = intFindCount
               .Update
            End With
            
            lngCount = lngCount + 1
            Debug.Print "Count: " & lngCount
            Call SysCmd(acSysCmdUpdateMeter, lngCount)

          End If
CheckNext:
      Next fil
      
      strTitle = "Done"
      strPrompt = lngCount & " documents searched in " & strPath
      MsgBox prompt:=strPrompt, _
         Buttons:=vbInformation + vbOKOnly, _
         Title:=strTitle
      Call SysCmd(acSysCmdRemoveMeter)
     
   End If
         
   DoCmd.OpenTable TableName:=strTable
      
ErrorHandlerExit:
   Set appWord = Nothing
   Set docSearch = Nothing
   Set fso = Nothing
   
   Exit Sub

ErrorHandler:
   If Err.Number = 4605 Then
      GoTo CheckNext
   Else
      MsgBox "Error No: " & Err.Number _
         & " in " & Me.ActiveControl.Name & " procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If
   
End Sub

Select allOpen in new window