Batch Text Replace VBA from Control File?

[binar]

Fellow Forum Members,
I need help developing a VBA script to batch text replace 120 TEXT files driven by a control list setup in Excel 2007. I need the VBA to perform as outlined below:

1) Open text file (by referencing path and filename data listed in Columns A & B)
2) Replace text within text file (by referencing data listed in Columns C & D)
3) Save changes done to text file
4) Close the text file.
5) Move on to next text file on list until end of list is reached.

In short, I’m seeking to utilize Excel as text replacer app to batch edit 120 NotePad text files all controlled from a batch list I have setup within Microsoft Excel 2007 with columns named: “PATH”, “FILENAME”, “ORIGINAL TEXT”, “REPLACEMENT TEXT” (see attachment). In the attached sample worksheet I have included a button named "Make Changes Now". By pressing on this button I would like the script to start running and make all changes to the files in the list.

Below is a VBA script that does not perform 100% the way I would like. However, I'm including it so that anyone out there willing to help me does not have to start from scratch with the coding. I hope the code below helps and I would be grateful if someone out there can modify it so that it performs as I described above.




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("TEST1", "TEST2", "TEST3")
SubstituteWords = Array("DONE1", "DONE2", "Done3")

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

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)
Replace Text, SearchForWords(I), SubstituteWords(I)
Next I
TextFile.Write Text
TextFile.Close
FileName = Dir()
Loop

End Sub



Any help greatly appreciated. Thanks.

[Tommy]

Hi binar,

Welcome to the board!

I am reading direct from the spreadsheet for the words to replace and replace with, the code posted takes an array and replaces each item in the array. So there are several things being replaced.

Function GetStrFile$(iFName$)
mFNo = FreeFile
Open iFName For Input As #mFNo
mLen& = LOF(mFNo)
GetStrFile = Input(mLen, #mFNo)
Close #mFNo
End Function
Sub PutStrFile(iFName$, iData$)
mFNo = FreeFile
Open iFName For Output As #mFNo
Print #mFNo, iData
Close #mFNo
End Sub
Sub ButtonMain()
Dim mData As String, I As Long
I = 2
With ActiveSheet
While Cells(I, 1) > ""
mData = GetStrFile(Cells(I, 1) & "\" & Cells(I, 2))
mData = Replace(mData, Cells(I, 3), Cells(I, 4))
PutStrFile Cells(I, 1) & "\" & Cells(I, 2), mData
I = I + 1
Wend
End With
End Sub

[binar]

Tommy,
Thanks for the post. Please disregard the text to replace in the VBA code I posted. This VBA code is old and it's from a previous exercise I attempted with no success. I posted this VBA code mainly for the purpose to inspire any VBA coder out there with ideas.

Also I was not aware that my attachments were blocked since I am a new member to this forum. I hope this post will activate my attachment. Inside the zip file you will find a sample Excel worksheet that shows the four columns of data I want to setup as a control file (the four columns are "PATH", "FILENAME", "ORIGINAL TEXT", and "REPLACEMENT TEXT"). You will also see a gray button to execute the script. Currently, this button is dead because I have no script. My goal is to have the list inside Excel to function as a control file that drives a batch operation that automatically replaces text defined in the control list among 120 NotePad files residing in the PATH I specify in the control list. I have included three sample NotePad files. The text changes I need to make are very basic. However, there are just too many of them to do them one file at a time.

Believe it or not there is no software company on the internet that is selling a software app that performs this function out of the box. There are many text replace apps out there for sale, but none of these apps replace text where a control file drives the batch operation. I find it amazing no coder out there has developed such an app. Therefore, I think the best way is to rely on Excel 2007 and hope that someone out there can help me out with a VBA script.

[binar]

Can anyone out there please help me out with this VBA script. Thank you.

[mancubus]

see if this helps...

http://www.exceltip.com/st/Replace_text_in_a_text_file_using_VBA_in_Microsoft_Excel/468.html

[mancubus]

found another option. tested on your sample files.

try...


Sub repltxtfiles()
'http://blogs.technet.com/b/heyscriptingguy/archive/2005/02/08/how-can-i-find-and-replace-text-in-a-text-file.aspx

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

LR = Cells(Rows.Count, 1).End(3).Row

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 2 To LR
fName = Range("A" & i) & "\" & Range("B" & i)
Set objFile = objFSO.OpenTextFile(fName, ForReading)

strText = objFile.ReadAll
objFile.Close

strNewText = Replace(strText, Range("C" & i), Range("D" & i))

Set objFile = objFSO.OpenTextFile(fName, ForWriting)
objFile.WriteLine strNewText

objFile.Close
Set objFile = Nothing
Next

End Sub

[binar]

Mancubus,
Thanks for your post, I have played around with both VBA scripts and I'm not getting good results with either one.

I would be very grateful if anyone out there can take a look at these scripts and provide a revised one that can function as I described in my original post. How can the code below be modified so that a control file comprised of data inside four columns named "PATH", "FILENAME", "ORIGINAL TEXT", and "REPLACEMENT TEXT" drives a batch text replace operation? Any help that will help me reach this goal will be greatly appreciated. Thanks.




Sub ReplaceTextInFile(SourceFile As String, _
sText As String, rText As String)
Dim TargetFile As String, tLine As String, tString As String
Dim p As Integer, i As Long, F1 As Integer, F2 As Integer
TargetFile = "RESULT.TMP"
If Dir(SourceFile) = "" Then Exit Sub
If Dir(TargetFile) <> "" Then
On Error Resume Next
Kill TargetFile
On Error GoTo 0
If Dir(TargetFile) <> "" Then
MsgBox TargetFile & _
" already open, close and delete / rename the file and try again.", _
vbCritical
Exit Sub
End If
End If
F1 = FreeFile
Open SourceFile For Input As F1
F2 = FreeFile
Open TargetFile For Output As F2
i = 1 ' line counter
Application.StatusBar = "Reading data from " & _
TargetFile & " ..."
While Not EOF(F1)
If i Mod 100 = 0 Then Application.StatusBar = _
"Reading line #" & i & " in " & _
TargetFile & " ..."
Line Input #F1, tLine
If sText <> "" Then
ReplaceTextInString tLine, sText, rText
End If
Print #F2, tLine
i = i + 1
Wend
Application.StatusBar = "Closing files ..."
Close F1
Close F2
Kill SourceFile ' delete original file
Name TargetFile As SourceFile ' rename temporary file
Application.StatusBar = False
End Sub
Private Sub ReplaceTextInString(SourceString As String, _
SearchString As String, ReplaceString As String)
Dim p As Integer, NewString As String
Do
p = InStr(p + 1, UCase(SourceString), UCase(SearchString))
If p > 0 Then ' replace SearchString with ReplaceString
NewString = ""
If p > 1 Then NewString = Mid(SourceString, 1, p - 1)
NewString = NewString + ReplaceString
NewString = NewString + Mid(SourceString, _
p + Len(SearchString), Len(SourceString))
p = p + Len(ReplaceString) - 1
SourceString = NewString
End If
If p >= Len(NewString) Then p = 0
Loop Until p = 0
End Sub
Sub TestReplaceTextInFile()
ReplaceTextInFile ThisWorkbook.Path & _
"\ReplaceInTextFile.txt", "|", ";"
' replaces all pipe-characters (|) with semicolons (;)

End Sub

[GTO]

I would suggest you zip up a couple of text files that accurately lay out what is before and what is wanted after.

[Tommy]

Hi binar,

Did you see my post where I said I was reading from the spreadsheet? I got the zip file un-compressed the files and wrote what I posted. I have now attached the workbook with the same exact code posted in it, which is also tied to the button.

Let me know if you need any explainations or if the code needs some tweeking.

Tommy

[Kenneth Hobs]

Using the method that mancubus posted with a few additions this seemed to work ok in a Module for me. Note the Replace line of code as I commented. You need to decide if you want case sensitive replacements or not.


Sub repltxtfiles()
'http://blogs.technet.com/b/heyscriptingguy/archive/2005/02/08/how-can-i-find-and-replace-text-in-a-text-file.aspx

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 = Cells(Rows.Count, 1).End(xlUp).Row

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 2 To LR
fName = 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

Obviously, your button code could be:
Private Sub CommandButton1_Click()
repltxtfiles
End Sub

[binar]

Kenneth, Mancubus, and to everyone else who participated in this thread, I'll like to give out a genuine thank you to everybody for helping me out with the development of this VBA script. I tested out Kenneth's version and it works like a charm! To me this script is a jewel. It's going to make mundane editing of a multitude of TEXT files a thing of the past for me. It's very powerful what this script does.

Kenneth, I hope you can answer these questions. Can my control list be 1000 rows? I'm wondering if there is any limit to how long the list can be. Also regarding CASE Sensitive replacement. I indeed do want Case Sensitive replacements and by testing this code several times I confirmed that the UPPERCASE text I included in the Replacement Text column is recognized by the script. This is great! However, so that I may have a solid understanding of this code, can you let me know what part of the code turns off the case sensitive feature? I'm not a VBA programmer, therefore I'm not too sure how the Case Sensitive replacement feature is changed to Non Case Sensitive Replacement.

Again, thanks a lot for the code. You guys made my day ! :hi:

[Kenneth Hobs]

I commented out the part for insensitive. In the snippet below, just comment out the 4th line and uncomment the 2nd to get it insensitive again. Once you understand it, you can delete out the comments. I recommend that you comment code even though you may understand it now. When you review it later, you will be reminded what was done.

For the code posted by Tommy, it can be adapted to work in a similar fashion. The concepts for both are valid.

'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)

[binar]

Thanks Kenneth. I think I'll leave the commented out code in there just in case I ever need it.

Again thanks to everyone for their help. I hope to see all of you in another thread I started that also involves text files and using a control list from within Excel. However, this task involves batch renaming filenames originating from a single seed text file. Below is a link to the thread:

http://www.vbaexpress.com/forum/showthread.php?t=36352

[Tommy]

I didn't even think about case senitivity until you said something about it Kenneth good catch.

[binar]

Using the method that mancubus posted with a few additions this seemed to work ok in a Module for me. Note the Replace line of code as I commented. You need to decide if you want case sensitive replacements or not.


Sub repltxtfiles()
'http://blogs.technet.com/b/heyscriptingguy/archive/2005/02/08/how-can-i-find-and-replace-text-in-a-text-file.aspx

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 = Cells(Rows.Count, 1).End(xlUp).Row

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 2 To LR
fName = 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

Obviously, your button code could be:
Private Sub CommandButton1_Click()
repltxtfiles
End Sub



:hi:

Hi Kenneth,
I hope you are doing well and that you are still visiting this forum. Back in March you posted a script that I'm using within Excel 2007 and has been very useful for what I do.

This Find and Replace Text script works perfectly within an Excel Worksheet with the following four columns:

A = PATH
B = FILENAME
C = ORIGINAL TEXT
D = REPLACEMENT TEXT

However, I have modified my worksheet to include a column that shows sequential numbers for better data organization. My new column layout is shown below:

A = ITEM NUMBER
B = PATH
C = FILENAME
D = ORIGINAL TEXT
E = REPLACEMENT TEXT

Evenmore, I made the following changes to your script:

fName = Range("A" & i) & "\" & Range("B" & i)

IS NOW = fName = Range("B" & i) & "\" & Range("C" & i)

AND
strNewText = Replace(strText, Range("C" & i), Range("D" & i)

IS NOW = strNewText = Replace(strText, Range("D" & i), Range("E" & i)


I thought these changes would compensate for the additional column I added and in turn your script will work just fine. The reality is a totally different matter. Your script does not like the edit I made.

I would be very grateful if you can edit your script so that it can work as before but with the additional "A" column I added.

I hope to hear back from you at your convenience. Thanks.

:hi:

[Kenneth Hobs]

That seems ok except you did not show the textcompare option.

Change:
strNewText = Replace(strText, Range("D" & i), Range("E" & i) To:
strNewText = Replace(strText, Range("D" & i), Range("E" & i),Compare:=vbBinaryCompare)

Also, since it checks for column A from the bottom up to get LR, Last Row, then be sure that column A has data as you expect. Since the column A data is not critical to the task, you can just have it check column B for LR.
Change:
LR = Cells(Rows.Count, 1).End(xlUp).Row To:
LR = Cells(Rows.Count, 2).End(xlUp).Row

[binar]

Hi Kenneth,
I made the changes you provided and I have posted the revised code below. I have tested it out and interesting enough I get the following message:

Run Time Error 13
Type Mismatch

When I hit Debug it shows the following code highlighted in Yellow:


strNewText = Replace(strText, Range("D" & i), Range("E" & i), Compare:=vbTextCompare)


My hunch is it's something to do with my data being bad. I'm going to play around some more with this tomorrow. For now thanks alot for the help.



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 = Cells(Rows.Count, 2).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 2 To LR
fName = Range("B" & i) & "\" & Range("C" & 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("D" & i), Range("E" & i), Compare:=vbTextCompare)
'Case sensitive
'strNewText = Replace(strText, Range("D" & i), Range("E" & 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

[Kenneth Hobs]

You can set the property Value to see if that helps. Depending on your data, the Text property might be a good choice.
Either:
strNewText = Replace(strText, Cstr(Range("D" & i).Value), CStr(Range("E" & i).Value), Compare:=vbTextCompare)
Or:
strNewText = Replace(strText, Range("D" & i).Text, Range("E" & i).Text, Compare:=vbTextCompare)

You might also have some blank cell values in columns D or E that might be a problem. A null value is not the same as "".

Use F8 to debug.

[binar]

Hi Kenneth,
Your VBA skills are beyond the ultimate that's humanly possible! In other words, they are superhuman! :thumb

Your code below works:



strNewText = Replace(strText, CStr(Range("D" & i).Value), CStr(Range("E" & i).Value), Compare:=vbTextCompare)


The Runtime Error 13 Type Mismatch no longer shows up and more importantly several text replacement operations that were being skipped before are now actually being done. I find this stuff amazing. What does the "CStr" that you added actually do? Does it make your script make more accurate text comparisons? Just curious.

Also, you mentioned blank cell values in columns D or E. It so happens my E Column has plenty of these error messages Excel autogenerates: #VALUE! . I had a hunch these #VALUE! entries may be to blame. I Googled "Hide Error Messages In Excel" but there seems to be no direct way to hide all of my error #VALUE! messages.

Nevertheless, your code is working fine with or without my #VALUE! error messages. I thank you a lot again for getting me out of this hole.
:thumb

[Kenneth Hobs]

You are too kind but thanks.

You can skip the error messages by putting this early on in the code:
On Error Resume Next I don't like using those sorts of things normally. It is better to code for errors that you expect might happen. We could probably use an If clause to skip processing lines of code where a column's value is null, "", NA, #Value, etc. depending on your data and needs.

CStr is an acronym for method Convert String. MicroSoft programmers are like me, they like short names. If you don't know what a command does, with the cursor in the word or one side of it, press F1 in the VBE to get specific help or press F2 in VBE and browse for it by typing it in a search box.

I normally would have used one of the Range object's property values of Value, Value2, or Text as I don't like to assume that the default property Value would be used rather than the object itself.