BatchReplaceTextInExcelFiles.vba

Public Sub BatchReplaceTextInWordFiles()
' https://www.datanumen.com/blogs/find-replace-contents-multiple-word-documents/
    Dim objDoc As Workbook
    Dim strFile As String
    Dim strFolder As String
    Dim oldNamesFile As String
    Dim newNamesFile As String
    Dim strFindText As String
    Dim strReplaceText As String
    Dim oldnames As New Collection
    Dim newnames As New Collection
  
    strFolder = "FOLDER PATH"
    oldNamesFile = "OLD NAMES PATH.txt"
    newNamesFile = "NEW NAMES PATH.txt"
  
    strFile = Dir(strFolder & "\" & "*.xlsx", vbNormal)
    
    Dim FileNum As Integer
    Dim DataLine As String
    
    FileNum = FreeFile()
    Open oldNamesFile For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        oldnames.Add DataLine
    Wend
    
    FileNum = FreeFile()
    Open newNamesFile For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        newnames.Add DataLine
    Wend
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
'  Open each file in the folder to search and replace texts. Save and close the file after the action.
    While strFile <> ""
        Set objDoc = Workbooks.Open(Filename:=strFolder & "\" & strFile)
        With objDoc
            For L = 1 To objDoc.Worksheets.Count
                objDoc.Worksheets(L).Activate
                    For I = 1 To oldnames.Count
                        objDoc.Worksheets(L).Cells.Replace _
                        What:=oldnames(I), Replacement:=newnames(I), _
                        SearchOrder:=xlByColumns, MatchCase:=False
                    Next
            Next L

            objDoc.Save
            objDoc.Close
            strFile = Dir()
        End With
    Wend
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End Sub

BatchReplaceTextInWordFiles.vba

Public Sub BatchReplaceTextInWordFiles()
    ' adapted from https://www.datanumen.com/blogs/find-replace-contents-multiple-word-documents/
    Dim objDoc As Document
    Dim strFile As String
    Dim strFolder As String
    Dim oldNamesFile As String
    Dim newNamesFile As String
    Dim strFindText As String
    Dim strReplaceText As String
    Dim oldnames As New Collection
    Dim newnames As New Collection
    
    strFolder = "FOLDER PATH"
    oldNamesFile = "OLD NAMES PATH.txt"
    newNamesFile = "NEW NAMES PATH.txt"

    strFile = Dir(strFolder & "\" & "*.doc*", vbNormal)
    
    Dim FileNum As Integer
    Dim DataLine As String
    
    ' collect old names
    FileNum = FreeFile()
    Open oldNamesFile For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        oldnames.Add DataLine
    Wend
    ' collect new names
    FileNum = FreeFile()
    Open newNamesFile For Input As #FileNum
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine
        newnames.Add DataLine
    Wend
    
    '  Open each file in the folder to search and replace texts. Save and close the file after the action.
    While strFile <> ""
        Set objDoc = Documents.Open(FileName:=strFolder & "\" & strFile)
        With objDoc
            With Selection
                .HomeKey Unit:=wdStory
                For i = 1 To oldnames.Count
                    With Selection.Find
                        .Text = oldnames(i)
                        .Replacement.Text = newnames(i)
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                    End With
                    Selection.Find.Execute Replace:=wdReplaceAll
                Next
            End With
            objDoc.Save
            objDoc.Close
            strFile = Dir()
        End With
    Wend
End Sub