Friday, March 4, 2011

Replace text into your .txt file with VBA

FielPath : Location of your Text file including file name. e.g.: c:\abc\abc.txt
oldStr : search string into the file 
newStr: replace the value with oldStr.


Sub TestReplaceTextInFile(filePath As String, oldStr As String, newStr As String)
    ReplaceTextInFile filePath, oldStr, newStr
End Sub

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

No comments:

Post a Comment

Your feedback is always appreciated. I will try to reply to your queries as soon as time allows.Please don't spam,spam comments will be deleted upon reviews.