Multiple Find and Replace Text String Files in Folder

exc4libur · Aug 22, 2016

Hi guys!

How are we all? Well i hope.

Quick summary: I am going through all ("*.txt") files in a folder and finding and replacing values from an excel list. I need to modify the code below so that I can do multiple find and replace.

The values to search for are in column "A" and the values to replace with are in column "B".

So far, I can only find and replace one value at a time. Any help would be much appreciated

Thanks in advance!

Code:

Sub ReplaceStringInFile()
'http://stackoverflow.com/questions/14840574/find-and-replace-string-in-all-excel-files-in-folder
Dim objFSO As Object
Dim objFil As Object
Dim objFil2 As Object
Dim StrFileName As String
Dim StrFolder As String
Dim SstrAll As String
Dim FindStr As String, ReplaceStr As String

FindStr = Range("a2").Value
ReplaceStr = Range("b2").Value

Set objFSO = CreateObject("scripting.filesystemobject") 'enable microsoft scripting runtime
StrFolder = "C:\test\" 'choose folder to go through
StrFileName = Dir(StrFolder & "*.txt") 'choose extension to find and replace

Do While StrFileName <> vbNullString
    Set objFil = objFSO.opentextfile(StrFolder & StrFileName)
    strAll = objFil.readall
    objFil.Close
    Set objFil2 = objFSO.createtextfile(StrFolder & StrFileName)
    objFil2.Write Replace(strAll, FindStr, ReplaceStr) 'choose what to find and replace *case sensitive
    objFil2.Close
    StrFileName = Dir
Loop
End Sub

shrivallabha · Aug 22, 2016

Maybe like this:

Code:

Sub ReplaceStringInFile()
'http://stackoverflow.com/questions/14840574/find-and-replace-string-in-all-excel-files-in-folder
Dim objFSO As Object
Dim objFil As Object
Dim objFil2 As Object
Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
Dim StrFileName As String
Dim StrFolder As String
Dim strAll As String
Dim FindStr As String, ReplaceStr As String

Set objFSO = CreateObject("scripting.filesystemobject") 'enable microsoft scripting runtime
StrFolder = "C:\TEMP\abc\" 'choose folder to go through
StrFileName = Dir(StrFolder & "*.txt") 'choose extension to find and replace

Do While StrFileName <> vbNullString
    Set objFil = objFSO.opentextfile(StrFolder & StrFileName)
    strAll = objFil.readall
    objFil.Close
    Set objFil2 = objFSO.createtextfile(StrFolder & StrFileName)
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        With regex
            .MultiLine = True
            .Global = True
            .IgnoreCase = False '\\ Change to true if you don't want case sensitivity
            .Pattern = Range("A" & i).Value
            strAll = .Replace(strAll, Range("B" & i).Value)
        End With
    Next i
    objFil2.Write strAll 'choose what to find and replace *case sensitive
    objFil2.Close
    StrFileName = Dir
Loop
Set regex = Nothing
End Sub

Chihiro · Aug 22, 2016

Here's another method. shrivallabha's method would be more efficient though.

Code:

Sub ReplaceStringInFile()
'http://stackoverflow.com/questions/14840574/find-and-replace-string-in-all-excel-files-in-folder
Dim objFSO As Object
Dim objFil As Object
Dim objFil2 As Object
Dim StrFileName As String
Dim StrFolder As String
Dim SstrAll As String
Dim FindStr As Variant, ReplaceStr As Variant
Dim lRow As Long

lRow = Cells(Rows.Count, 1).End(xlUp).Row

FindStr = Range("A2:A" & lRow)
ReplaceStr = Range("B2:B" & lRow)

Set objFSO = CreateObject("scripting.filesystemobject") 'enable microsoft scripting runtime
StrFolder = "C:\test\" 'choose folder to go through
StrFileName = Dir(StrFolder & "*.txt") 'choose extension to find and replace

Do While StrFileName <> vbNullString
    Set objFil = objFSO.opentextfile(StrFolder & StrFileName)
    strall = objFil.readall
    objFil.Close
    Set objFil2 = objFSO.createtextfile(StrFolder & StrFileName)
    For i = LBound(FindStr, 1) To UBound(FindStr, 1)
        strall = Replace(strall, FindStr(i, 1), ReplaceStr(i, 1)) 'choose what to find and replace *case sensitive
    Next i
    objFil2.Write strall
  objFil2.Close
    StrFileName = Dir
Loop
End Sub

exc4libur · Aug 22, 2016

Thank you all very much

They both work spectacularly! Also, thanks for the quick help!!!
Rgds

exc4libur · Aug 22, 2016

Hi shrivallabha, could you add one more thing? I wanted to report/list all the files that where looped and the entire text content beside it. Is it possible? Thank you.

shrivallabha · Aug 22, 2016

exc4libur said:
Hi shrivallabha, could you add one more thing? I wanted to report/list all the files that where looped and the entire text content beside it. Is it possible? Thank you.

Where do you want to list it? Entire content before or after (in a cell) assuming file content is manageable?

exc4libur · Aug 22, 2016

shrivallabha said:
Where do you want to list it? Entire content before or after (in a cell) assuming file content is manageable?

Uh, I was thinking of adding new wkb or wksheet and paste the entire content "after" (the replace) in a cell. I would love to have before as well, but for some txt the content is bigger than cell capacity (32kb).

shrivallabha · Aug 22, 2016

Test below modified code and see if it does what you want. It should create one unsaved workbook where it will keep list of all files and insert one sheet each for textfile showing before and after contents.

Code:

Sub ReplaceStringInFileV2()
'http://stackoverflow.com/questions/14840574/find-and-replace-string-in-all-excel-files-in-folder
Dim objFSO As Object
Dim objFil As Object
Dim objFil2 As Object
Dim regex As Object: Set regex = CreateObject("VBScript.RegExp")
Dim StrFileName As String
Dim StrFolder As String
Dim strAll As String
Dim FindStr As String, ReplaceStr As String
Dim wbk As Workbook
Dim wks As Worksheet
Dim varData As Variant
Dim iCnt As Long

Set objFSO = CreateObject("scripting.filesystemobject") 'enable microsoft scripting runtime
StrFolder = "C:\test\" 'choose folder to go through
StrFileName = Dir(StrFolder & "*.txt") 'choose extension to find and replace

Set wbk = Workbooks.Add
wbk.Sheets(1).Range("A1").Value = "File Name"
wbk.Sheets(1).Range("B1").Value = "Link"
iCnt = 2

Do While StrFileName <> vbNullString
   
    Set objFil = objFSO.opentextfile(StrFolder & StrFileName)
    strAll = objFil.readall
    objFil.Close
   
    Set wks = wbk.Sheets.Add(After:=wbk.Sheets(wbk.Sheets.Count))
    wks.Name = StrFileName
    wbk.Sheets(1).Range("A" & iCnt).Value = StrFileName
    wbk.Sheets(1).Hyperlinks.Add wbk.Sheets(1).Range("B" & iCnt), "", "'" & StrFileName & "'!A1", , "Click Here"
    wks.Hyperlinks.Add wks.Range("A1"), "", wbk.Sheets(1).Name & "!A1", , "Home"
    wks.Range("A2").Value = "Before"
    varData = Split(strAll, vbCrLf)
    wks.Range("A3").Resize(UBound(varData) + 1, 1).Value = Application.Transpose(varData)
   
    Set objFil2 = objFSO.createtextfile(StrFolder & StrFileName)
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        With regex
            .MultiLine = True
            .Global = True
            .IgnoreCase = False '\\ Change to true if you don't want case sensitivity
            .Pattern = Range("A" & i).Value
            strAll = .Replace(strAll, Range("B" & i).Value)
        End With
    Next i
    objFil2.Write strAll 'choose what to find and replace *case sensitive
    objFil2.Close
   
    wks.Range("B2").Value = "After"
    varData = Split(strAll, vbCrLf)
    wks.Range("B3").Resize(UBound(varData) + 1, 1).Value = Application.Transpose(varData)
    iCnt = iCnt + 1
    StrFileName = Dir
Loop
Set regex = Nothing
End Sub

exc4libur · Aug 22, 2016

shrivallabha said:
Test below modified code and see if it does what you want. It should create one unsaved workbook where it will keep list of all files and insert one sheet each for textfile showing before and after contents.

Code:

Very nice, thank you so much!

rgds

exc4libur · Aug 26, 2016

Shrivallabha,

I've ran into some trouble. Some of the text files are very large and I only need to pull a couple of things from them. I was using the MultiReplace routine to make the files smaller so that I could import each file into one single cell on the worksheet (obeying the character limit of 32,767) and then parsing the data. However, this task has become very difficult when you have to work with more than 100 files.

I have attached an example workbook containing the layout and the criterias as well as an example text file.

Thank you.

Marc L · Aug 26, 2016

Hi !

The question is : why using Excel ?!
As you can directly do it directly under DOS or Windows,
even in a programmatic way in VBScript or whatever the code language !

Even via VBA, you do not need to copy any data in a cell !
Read all data within a String variable, update it via Replace function
and write back variable to the file …

exc4libur · Aug 26, 2016

Marc L said:

Hi marc

I think I have part of the solution. I need a little help though. I'm missing:
1. Loop through "text" files in the folder;
2. Remove """ quotes from text files;
(tried searching with quotation marks but didn't work)
3. Get the values in between the first and last string;
a. First search string values start in [Column B to LastCol, Row 1];
b. Last search string values start in [Column B to LastCol, Row 2];
4. Paste the text file searched starting in Row 3.

I have this code so far:

Code:

Sub ExtractTxtValue()
    Dim filename As String, nextrow As Long, MyFolder As String
    Dim MyFile As String, text As String, textline As String, firstStr As String, lstStr As String
   
    MyFolder = "C:\Users\vfham\Desktop\bestcenter\"
    MyFile = Dir(MyFolder & "*.txt")

    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
            Line Input #1, textline
            text = text & textline 'second loop text is already stored -> see reset text
        Loop
        Close #1
        MyFile = Dir()
        Debug.Print text
        firstStr = InStr(text, Range("b1").Value)
        lstStr = InStr(text, Range("b2").Value)
        nextrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
        ActiveSheet.Cells(nextrow, "b").Value = Mid(text, firstStr, lstStr - firstStr)
        text = "" 'reset text
    Loop
End Sub

Please find attached a sample workbook and text file.

Marc L · Aug 27, 2016

1) A loop with Dir VBA function until it returns an empty string,
like the sample in VBA inner help …

Use Input(LOF(F), #F) to read entire text file at once ! (F as file number)
See samples in threads of this forum and VBA inner help as well …
Other way is already in post #8 code ‼

2) Via Replace VBA text function; """" is one double quote in a string …

3) B1 cell value does not exist in your text file ‼
As you can check with any text editor search function …

Use InStr VBA text function to find out the position of a text within a string.
Use also Len VBA text function for the length of a string.
Other way is to play with Split VBA text function …

4) Via Replace VBA text function.

exc4libur · Aug 27, 2016

Ah sorry for the B1 value, I attached a sample text without it. But Yey, thank you for your time I got it!!!!

Code:

Sub GetValuesInBetweenFiles()
    Dim FileName As String, NextRow As Long, c As Long
    Dim MyFile As String, Text As String, TextLine As String, beginStr As String, endStr As String
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        xFileDialog.AllowMultiSelect = False
        xFileDialog.Title = "Select a folder"
        If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1) & "\"
        End If
        If xStrPath = "" Then Exit Sub
    MyFile = Dir(xStrPath & "*.txt")
    Do While MyFile <> ""
        Open (xStrPath & MyFile) For Input As #1
    Do Until EOF(1)
            Line Input #1, TextLine
            Text = Text & TextLine
    Loop
        Close #1
        NextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For c = 2 To ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    On Error Resume Next
        ActiveSheet.Cells(NextRow, 1).Value = MyFile 'paste filename
            beginStr = InStr(Text, Cells(1, c).Value) + Len(Cells(1, c).Value) 'find beginning string
            endStr = InStr(Text, Cells(2, c).Value) 'find ending string
        ActiveSheet.Cells(NextRow, c).Value = Trim(Application.Clean(Mid(Text, beginStr, endStr - beginStr))) 'paste value in between
    Next c
        MyFile = Dir
        Text = ""
    Loop
End Sub

Marc L · Aug 27, 2016

Yes, from AlphaFrog on Excel Forum ‼

…

Wild cross posting is very not appreciated, in particular on Excel Forum
like here too ! In fact on most forums !

Multiple Find and Replace Text String Files in Folder

exc4libur

Member

shrivallabha

Excel Ninja

Chihiro

Excel Ninja

exc4libur

Member

exc4libur

Member

shrivallabha

Excel Ninja

exc4libur

Member

shrivallabha

Excel Ninja

exc4libur

Member

exc4libur

Member

Attachments

Marc L

Excel Ninja

exc4libur

Member

Attachments

Marc L

Excel Ninja

exc4libur

Member

Marc L

Excel Ninja