Find values in TXT file and replace with values from Excel cells

Question

I'm looking for a macro to find and replace values in a txt file.

The txt file is located in the route

D:\Template\info.txt

This file looks like this (really the file has a HTML code, but I synthesized here the important part)

The current date and time is: %time%

GPU1 Temperature is: %GPU1T%
GPU1 Fan Speed is: %GPU1F%
GPU1 RPM are: %GPU1R%

GPU2 Temperature is: %GPU2T%
GPU2 Fan Speed is: %GPU2F%
GPU2 RPM are: %GPU2R%

and the Excel file looks like this

What I need is a macro that can find and replace the following:

Find %time% in the txt file and replace with the value of cell G2
Find %GPU1T% in the txt file and replace with the value of cell A2
Find %GPU1F% in the txt file and replace with the value of cell C2
Find %GPU1R% in the txt file and replace with the value of cell E2
Find %GPU2T% in the txt file and replace with the value of cell B2
Find %GPU2F% in the txt file and replace with the value of cell D2
Find %GPU2R% in the txt file and replace with the value of cell F2

After that, of course save the file but in a NEW location which is

D:\GPUReport

but with the same name info.txt

So far, trying to handle with this macro with no success

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
 

   SearchForWords = Array("%time%", "%GPU1T%", "%GPU1F%", "%GPU1R%", "%GPU2T%", "%GPU2F%", "%GPU2R% ")
   SubstituteWords = Array(Range("G2"), Range("A2"), Range("C2"), Range("E2"), Range("B2"), Range("D2"), Range("F2"))
 

   FolderPath = "D:\Template\info.txt"
   
     Set FSO = CreateObject("Scripting.FileSystemObject")
   
     FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
     FileName = Dir(FolderPath & "\*.txt")
   
     Do While FileName <> ""
       Filespec = FolderPath & FileName

         Set TextFile = FSO.OpenTextFile(Filespec, 1, False)
           Text = TextFile.ReadAll
         TextFile.Close
         

         Set TextFile = FSO.OpenTextFile(Filespec, 2, False)
           For I = 0 To UBound(SearchForWords)
             Replace Text, SearchForWords(I), SubstituteWords(I)
           Next I
         TextFile.Write Text
         TextFile.Close
       FileName = Dir()
     Loop
     
End Sub

I hope someone can help me with this.

Thank you so much in advance!

Answer 1

Try something like this:

Sub Tester()
    Dim txt As String, arr, c As Long
    
    arr = ThisWorkbook.Sheets("config").Range("A1:G2").Value
    txt = GetContent("C:\Tester\info.txt")
    For c = 1 To UBound(arr, 2)
        txt = Replace(txt, "%" & arr(1, c) & "%", arr(2, c))
    Next c
    PutContent "C:\Tester\info2.txt", txt
End Sub

Function GetContent(f As String) As String
    GetContent = CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 1).readall()
End Function

Sub PutContent(f As String, content As String)
    CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 2, True).write content
End Sub

Edit : just noticed that your headers are different from your placeholder tokens but it would be easier to make them the same (but don't include the "%" around the headers). Or add another row under the column headers to contain the placeholder text for that column.