Excel macro to find and replace multiple strings in any text file

Question

I used below code from your site to replace strings in a text file and it works fine. But, I don't want specify a file name, it should ready any file like (*.txt or *.xml).

Sub ReplaceStringInFile()

Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String

' Edit as needed
sFileName = "C:\Temp\test.txt"

iFileNum = FreeFile
Open sFileName For Input As iFileNum

Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum

sTemp = Replace(sTemp, "THIS", "THAT")

iFileNum = FreeFile
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum

End Sub

Answer 1

Sub ReplaceStringInFile()

Dim sBuf As String
Dim sTemp As String
Dim sFileName As String
Dim FileExt(2) As String

ruta = Application.ActiveWorkbook.Path

ChDrive ruta
ChDir ruta

FileExt(1) = "txt"
FileExt(2) = "xml"

For i = 1 To 2

  sFileName = Dir("*." & FileExt(i))

  Do

    If sFileName = "" Then Exit Do

    sTemp = ""
    Open sFileName For Input As #1
      Do Until EOF(1)
        Line Input #1, sBuf
        sTemp = sTemp & sBuf & vbCrLf
      Loop
    Close #1

    sTemp = Replace(sTemp, "THIS", "THAT")

    Open sFileName For Output As #1
      Print #1, sTemp
    Close #1

    sFileName = Dir()

  Loop

Next i

End Sub

Answer 2

You can iterate through items in an array!!

Sub FindAndReplaceText()

 Dim FileName As String
 Dim FolderPath As String
 Dim FSO As Object
 Dim I As Integer
 Dim SearchForWords As Variant
 Dim SubstituteWords As Variant
 Dim Text As String
 Dim TextFile As Object

  'Change these arrays to word you want to find and replace
  SearchForWords = Array("string1", "string2", "string3")
  SubstituteWords = Array("string100", "string200", "string300")

  'Change the folder path to where your text files are.
   FolderPath = "C:\your_path_here\"

     Set FSO = CreateObject("Scripting.FileSystemObject")

     FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
     FileName = Dir(FolderPath & "\*.txt")

     Do While FileName <> ""
       FileSpec = FolderPath & FileName
        'Read all the file's text into a string variable.
         Set TextFile = FSO.OpenTextFile(FileSpec, 1, False)
           Text = TextFile.ReadAll
         TextFile.Close

        'Scan the string for words to replace and write the string back to the file.
         Set TextFile = FSO.OpenTextFile(FileSpec, 2, False)
           For I = 0 To UBound(SearchForWords)
           Debug.Print Text
             Replace Text, SearchForWords(I), SubstituteWords(I)
           Debug.Print Text
           Next I
         TextFile.Write Text
         TextFile.Close
       FileName = Dir()
     Loop

End Sub