Search Replace in Text files - Loop to Next Search & Replacement

[dj44]

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/show...m-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]

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?

[dj44]

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]

OK. Without a text file etc. I can't suggest anything else.

[dj44]

oh an actual text file

a.zip

and i tested with
Search | Replace
Apple | Car
Pear | Train


I just used this as a test

[p45cal]

Arange your data thus (note column A has data filled to the bottom:
2018-07-23_224032.jpg

[dj44]

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

But this will help me do it one press

cheers and good week!

[p45cal]

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

[dj44]

Thank you for this extra help

thats stellar!

Have a great week!

[p45cal]

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]

@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]

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]

Thanks for reply p45cal,

In attach is my file. Of course there are a lot more file then show there (3 file)

[p45cal]

The attached has comments in the code to guide you.
The idea is that you can have your sheet like this:
2018-07-25_010204.jpg
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]

p45cal,

Excellent. Thank you so much.