View Full Version : [SOLVED:] Search Replace in Text files - Loop to Next Search & Replacement
good sunday,
i am tryign to do search and replacements in text files
i found this
it only replaced the first instance and didnt move on to the next
http://www.vbaexpress.com/forum/showthread.php?36304-Batch-Text-Replace-VBA-from-Control-File
Sub repltxtfiles()
Const ForReading = 1
Const ForWriting = 2
Dim objFSO As Object
Dim objFile As Object
Dim fName As String
Dim i As Long, LR As Long
Dim strText As String, strNewText As String
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = 2 To LR
fName = ThisWorkbook.ActiveSheet.Range("A" & i) & "\" & Range("B" & i)
If Not objFSO.FileExists(fName) Then GoTo Nexti
Set objFile = objFSO.OpenTextFile(fName, ForReading)
strText = objFile.ReadAll
objFile.Close
'Case insensitive
strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbTextCompare)
'Case sensitive
'strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
Set objFile = objFSO.OpenTextFile(fName, ForWriting)
objFile.WriteLine strNewText
objFile.Close
Set objFile = Nothing
Nexti:
Next i
Set objFSO = Nothing
End Sub
Private Sub CommandButton1_Click()
repltxtfiles
End Sub
Worksheet set up as below
File Path (A) | File Name (B) | Search (C) | Replacement (D)
C:\Users\DJ\Desktop\ a.txt hello hi
apple cherry
I am wondering why only the first replacement and not all the others set up
thank you for your help
p45cal
07-23-2018, 04:16 AM
I've tested this here and it replaces all instances.
Perhaps something to do with your text files; could you supply an example text file, with what's being sought and replaced?
Hello P,
i was just using a normal text file
_____________________________________________
Apple You can also type a Pear keyword to search online for the video that best fits your document.
To make your document look professionally produced, Word provides header, footer, cover page, and text box designs that complement each other.
_____________________________________________
It replaced the first one, but not the subsequent
thank you for testing it
p45cal
07-23-2018, 07:29 AM
OK. Without a text file etc. I can't suggest anything else. :(
oh an actual text file
22609
and i tested with
Search | Replace
Apple | Car
Pear | Train
I just used this as a test
p45cal
07-23-2018, 02:44 PM
Arange your data thus (note column A has data filled to the bottom:
22610
thank you my friend,
that worked
now to do a single file with lots of replacements i only added the file name below
Sub Search_Replace_TextFile()
Const ForReading = 1
Const ForWriting = 2
Dim objFSO As Object
Dim objFile As Object
Dim fName As String
Dim i As Long, LR As Long
Dim strText As String, strNewText As String
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = 2 To LR
fName = "C:\Users\DJ\Desktop\a.txt" ' <<< Single Text file
Set objFile = objFSO.OpenTextFile(fName, ForReading)
strText = objFile.ReadAll
objFile.Close
'Case insensitive
strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbTextCompare)
'Case sensitive
'strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
Set objFile = objFSO.OpenTextFile(fName, ForWriting)
objFile.WriteLine strNewText
objFile.Close
Set objFile = Nothing
Nexti:
Next i
Set objFSO = Nothing
End Sub
I was trying to lots of replacements in my text file, one by one is very tedious :type
But this will help me do it one press
cheers and good week!
p45cal
07-24-2018, 02:15 AM
That involves a lot of unnecessary opening and closing of the file; do it once only:
Sub Search_Replace_TextFile()
Const ForReading = 1
Const ForWriting = 2
Dim objFSO As Object
Dim objFile As Object
Dim fName As String
Dim i As Long, LR As Long
Dim strText As String
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")
fName = "C:\Users\DJ\Desktop\a.txt" ' <<< Single Text file
Set objFile = objFSO.OpenTextFile(fName, ForReading)
strText = objFile.ReadAll
objFile.Close
For i = 2 To LR
'Case insensitive
strText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbTextCompare)
'Case sensitive
'strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
Next i
Set objFile = objFSO.OpenTextFile(fName, ForWriting)
objFile.WriteLine strText
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Sub
(Tested)
If you don't want to have to put something in column A to ensure it goes through all the search/replace pairs, determine last row (LR) using another column, say C or D?
So instead of:
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
use:
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
or:
LR = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
Thank you for this extra help :)
thats stellar!
Have a great week!
p45cal
07-24-2018, 09:21 AM
just noticed:
'strNewText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
should be:
'strText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
Tom Jones
07-24-2018, 10:25 AM
@p45cal,
Having the data set as in post no. 6, how to change your code to take the path from column A & "/" & B, (fName = ThisWorkbook.ActiveSheet.Range("A" & i) & "" & Range("B" & i)), not directly from the code (fName = "C: \ Users \ DJ \ Desktop \ a.txt")
Thank you.
p45cal
07-24-2018, 10:37 AM
Supply a sheet (preferably an actual workbook, but a last resort is a picture) with the data as it really is (not more than 20ish rows though), including multiple file names if there are going to be more than one, then I should be able to give you a definitive answer.
Tom Jones
07-24-2018, 11:50 AM
Thanks for reply p45cal,
In attach is my file. Of course there are a lot more file then show there (3 file)
p45cal
07-24-2018, 05:06 PM
The attached has comments in the code to guide you.
The idea is that you can have your sheet like this:
22620
Where there are blank cells in columns A and B, their value is assumed to be the same as the first non-blank cell above it.
The same does NOT apply to column C and D.
The code should only open and close files when a file name (effectively) changes as it works its way down the list.
Do test it thoroughly.
This is the code but it's in the file:
Sub Search_Replace_TextFile()
Const ForReading = 1
Const ForWriting = 2
Dim objFSO As Object
Dim objFile As Object
Dim fName As String, CurrentfName As String, g As String, FolderName As String, FilName As String
Dim i As Long, LR As Long
Dim strText As String
With ActiveSheet
'Assign a few things:
LR = .Cells(Rows.Count, "C").End(xlUp).Row 'uses column C to determine extent of data to process.
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Make an initial check that A2:B2 contains a valid folder name and file name and that that file exists, otherwise abort:
fName = .Range("A" & 2).Value & "\" & .Range("B" & 2).Value
If objFSO.fileexists(fName) Then
For i = 2 To LR
'this bit handles blanks in column A and B and makesthe assumption if there's a blank it means it's the same as the first non-blank above it.
'.Range("A" & i).Select 'debug line
g = .Range("A" & i).Value
If Len(Application.Trim(g)) > 0 Then FolderName = g
g = .Range("B" & i).Value
If Len(Application.Trim(g)) > 0 Then FilName = g
fName = FolderName & "\" & FilName
If fName <> CurrentfName Then 'it's a different file so
'write/update existing file:
If Len(CurrentfName) > 0 Then '(but check that there is an open file first)
Set objFile = objFSO.OpenTextFile(CurrentfName, ForWriting)
objFile.WriteLine strText
objFile.Close
End If
'open new file and read and close:
Set objFile = objFSO.OpenTextFile(fName, ForReading)
strText = objFile.ReadAll
objFile.Close
'update current file name:
CurrentfName = fName
End If
'Case insensitive:
strText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbTextCompare)
'Case sensitive:
'strText = Replace(strText, Range("C" & i), Range("D" & i), Compare:=vbBinaryCompare)
Next i
'update and close the last file:
Set objFile = objFSO.OpenTextFile(CurrentfName, ForWriting)
objFile.WriteLine strText
objFile.Close
Else
MsgBox "File in A2:B2 doesn't exist. Aborting"
End If
End With
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Tom Jones
07-25-2018, 12:26 AM
p45cal,
Excellent. Thank you so much.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.