Just find, highlight, and specify the file name, no replace
Hi, guys
How to make the following code finds for the String in the folder and then color it and specify the names of the files that contain them:
Thanks in advance
Code:
Public Sub MassReplace()
Dim strPath As String
Dim strFile As String
Dim FType As String
Dim FName As String
Dim strFind As String
Dim strReplace As String
Dim WordApp As Object
Dim WordDoc As Object
'The text above defines your objects
strFind = InputBox("Enter Text to find")
strReplace = InputBox("Enter replacement Text")
' user defines text they want to find and replace using input boxes
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
strFile = Dir(strPath & "*.docx*")
End If
Application.ScreenUpdating = False
'The block of code above allows the user to select the folder file to search
Do While strFile <> "" 'Do this while strFile is not blank
Set WordApp = CreateObject("Word.Application") 'Open MS word
WordApp.Visible = True 'Make word visible
Set WordDoc = WordApp.Documents.Open(strPath & strFile) 'open file in folder
WordApp.ActiveDocument.Range.Select ' select all text
With WordApp.Selection.Find 'Using the find function allows a search of text
.Text = strFind 'find "strFind"
.Replacement.Text = strReplace 'replacement text is "strReplace"
.Wrap = wdFindContinue
'.Format = False
'.MatchCase = False
'.MatchWholeWord = False
'.MatchWildcards = False
'.MatchSoundsLike = False
.Execute Replace:=wdReplaceAll 'replace all text
WordApp.ActiveDocument.Close wdSaveChanges 'Close document and save changes
End With 'End with block
WordApp.Quit 'Close the word application
strFile = Dir 'Go back to the directory
Loop
Application.ScreenUpdating = True
End Sub
