D
DHallam
Hi,
I an trying to put together code that will let me replace text in
text file. I have copied a previous example off this web site and i
works well. The only trouble is I want to find a string within a tex
file and replace not only that string but the following 10 strings.
The example below replaces whats in cell A1 with B1 but I would lik
this to be extended to L2, is this possible?
Many Thanks
Dave
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
SourceFile = "C:\Documents and Settings\Chri
Hallam\Desktop\origionalRESULT.txt"
TargetFile = "C:\Documents and Settings\Chris Hallam\Desktop\New.txt"
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 an
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", Range("a2"), Range("b1")
End Su
I an trying to put together code that will let me replace text in
text file. I have copied a previous example off this web site and i
works well. The only trouble is I want to find a string within a tex
file and replace not only that string but the following 10 strings.
The example below replaces whats in cell A1 with B1 but I would lik
this to be extended to L2, is this possible?
Many Thanks
Dave
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
SourceFile = "C:\Documents and Settings\Chri
Hallam\Desktop\origionalRESULT.txt"
TargetFile = "C:\Documents and Settings\Chris Hallam\Desktop\New.txt"
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 an
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", Range("a2"), Range("b1")
End Su