Found this coding online, was wondering if anyone had any idea how to modify this to deal with .txt documents.
Public Sub BatchReplaceAnywhere()
'Based on a macro by Doug Robbins
'with additional input from Peter Hewett
'and Greg Maxey to replace text in all
'the documents in a folder, wherever that text appears.
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape
'*******************************************************
' Use this folder selection for Word versions 2002-7
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
' Get the folder containing the files
With fDialog
.Title = "Select Folder containing the documents to be modified and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "Batch Replace Anywhere"
Exit Sub
End If
PathToUse = fDialog.SelectedItems.Item(1)
If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
End With
'Close any documents that may be open
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
'*******************************************************
'End of Folder selectiom
'*******************************************************
'Alternative folder selection for older Word versions
'With Dialogs(wdDialogCopyFile)
' If .Display <> 0 Then
' PathToUse = .Directory
' Else
' MsgBox "Cancelled by User"
' Exit Sub
' End If
'End With
'If Documents.Count > 0 Then
' Documents.Close Savechanges:=wdPromptToSaveChanges
'End If
'
'FirstLoop = True
'
'If Left(PathToUse, 1) = Chr(34) Then
' PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
'End If
'**********************************************************
'End of folder selection version 2
myFile = Dir$(PathToUse & "*.txt")
While myFile <> ""
'Get the text to be replaced and the replacement
If FirstLoop = True Then
pFindTxt = InputBox("Enter the text that you want to replace.", _
"Batch Replace Anywhere")
If pFindTxt = "" Then
MsgBox "Cancelled by User", , _
"Batch replace Anywhere"
Exit Sub
End If
Tryagain:
pReplaceTxt = InputBox("Enter the replacement text.", _
"Batch ReplaceAnywhere ")
If pReplaceTxt = "" Then
If MsgBox("Do you just want to delete the found text?", _
vbYesNoCancel, "Batch Replace Anywhere") = vbNo Then
GoTo Tryagain
ElseIf vbCancel Then
MsgBox "Cancelled by User.", , "Batch Replace Anywhere"
Exit Sub
End If
End If
End If
FirstLoop = False
'Open each file and make the replacement
Set myDoc = Documents.Open(PathToUse & myFile)
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngstory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
SrcAndRplInStory oShp.TextFrame.TextRange, _
pFindTxt, pReplaceTxt
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
'Close the file, saving the changes.
myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub
Public Sub SrcAndRplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
Public Sub BatchReplaceAnywhere()
'Based on a macro by Doug Robbins
'with additional input from Peter Hewett
'and Greg Maxey to replace text in all
'the documents in a folder, wherever that text appears.
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape
'*******************************************************
' Use this folder selection for Word versions 2002-7
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
' Get the folder containing the files
With fDialog
.Title = "Select Folder containing the documents to be modified and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "Batch Replace Anywhere"
Exit Sub
End If
PathToUse = fDialog.SelectedItems.Item(1)
If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
End With
'Close any documents that may be open
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
'*******************************************************
'End of Folder selectiom
'*******************************************************
'Alternative folder selection for older Word versions
'With Dialogs(wdDialogCopyFile)
' If .Display <> 0 Then
' PathToUse = .Directory
' Else
' MsgBox "Cancelled by User"
' Exit Sub
' End If
'End With
'If Documents.Count > 0 Then
' Documents.Close Savechanges:=wdPromptToSaveChanges
'End If
'
'FirstLoop = True
'
'If Left(PathToUse, 1) = Chr(34) Then
' PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
'End If
'**********************************************************
'End of folder selection version 2
myFile = Dir$(PathToUse & "*.txt")
While myFile <> ""
'Get the text to be replaced and the replacement
If FirstLoop = True Then
pFindTxt = InputBox("Enter the text that you want to replace.", _
"Batch Replace Anywhere")
If pFindTxt = "" Then
MsgBox "Cancelled by User", , _
"Batch replace Anywhere"
Exit Sub
End If
Tryagain:
pReplaceTxt = InputBox("Enter the replacement text.", _
"Batch ReplaceAnywhere ")
If pReplaceTxt = "" Then
If MsgBox("Do you just want to delete the found text?", _
vbYesNoCancel, "Batch Replace Anywhere") = vbNo Then
GoTo Tryagain
ElseIf vbCancel Then
MsgBox "Cancelled by User.", , "Batch Replace Anywhere"
Exit Sub
End If
End If
End If
FirstLoop = False
'Open each file and make the replacement
Set myDoc = Documents.Open(PathToUse & myFile)
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngstory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case rngstory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngstory.ShapeRange.Count > 0 Then
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
SrcAndRplInStory oShp.TextFrame.TextRange, _
pFindTxt, pReplaceTxt
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
'Close the file, saving the changes.
myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub
Public Sub SrcAndRplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
