How can I find and replace only certain instances of a word in a text file ?

[vgnadeau]

Hi. I am receiving an XML file that needs to be 'tweeked' before I can properly import it into to my Access database. I need to replace the first and fourth instance of'cb:TRINGLE'. I am able to replace the first instance of ‘cb:TRINGLE’ in the xml file. My problem now is that I do not want all instances to be replaced. I only want the first and fourth … In the following code you can see that I am able to locate the position of the fourth instance (I think) but I end up with the entire begining of the file missing!

Is there a better way to only replace certain matches with the Replace function?

Function FindAndReplaceXMLText()
Dim sSearchText As String
Dim sReplaceText As String
Dim sFileName As String
Dim sFileText As String
Dim strText As String
Dim strNewText As String
Dim intWhere1 As Integer
Dim FirstPos, NextPos

Const ForReading = 1
Const ForWriting = 2

sSearchText = “cb:TRINGLE”
sReplaceText = “cb:MATERIAL”

sFileName = “C:XMLtestexport.xml”

‘Create instance of FileSystemObject.
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)

‘read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close

‘Search for text in string.
strNewText = Replace(strText, sSearchText, sReplaceText, , 1, vbTextCompare)

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

‘Create instance of FileSystemObject.
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)

‘read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close
FirstPos = InStr(1, strText, sSearchText, 1)
NextPos = FirstPos + 10
FirstPos = InStr(NextPos, strText, sSearchText, 1)
NextPos = FirstPos + 10

strNewText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)

Set objFile = objFSO.OpenTextFile(sFileName, ForWriting)

objFile.WriteLine strNewText
objFile.Close

End Function

Can someone please help me with this?!

[thelonelyghost]

Wow! I've edited this post a few times because I keep misunderstandin g your post (purely due to stupidity on my part), and it seems like you've got it right for the most part. I just have a couple points to make.

For the sake of cleaning things up, you declared (but never used) the variables sFileText and intWhere1. If they're used elsewhere, obviously keep them. Otherwise they seem to serve no purpose but to take up space.

Second, look at the documentation for the Replace function. It has the ability to start the search/replace after a certain position. It looks like this could be remedied by a For-Each- and While-loop.

'User Settings: replaces instances 1 and 4
Dim inst As Integer
  inst = Array(1,4)

'Make a for-each loop to skip until the given instance
For Each i In inst
  NextPos = 1
  
  Do While i > 0
    FirstPos = InStr(NextPos, strText, sSearchText, vbTextCompare)
    NextPos = FirstPos + Len(sSearchText)
    i = i - 1
  Loop
  
  strText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)
  
Next i

I haven't tested this, but it's a simple concept of a for-each-loop within the array. Within the for-each is a while-loop that essentially tells it to skip each instance until it reaches the instance specified by the array. Currently it should be set to replace the first instance and 4th instance.

NOTE: I haven't tested this since I don't have an environment set up similar to yours yet. I forsee a possible issue with old-instance 4 becoming new-instance 3 after replacing old-instance 1.

Let me know if it works or, if not, what errors you see.

[vgnadeau]

Here's what I have for code now;

Function FindAndReplaceXMLText()

Dim sSearchText As String

Dim sReplaceText As String

Dim sFileName As String

Dim strText As String

Dim FirstPos, NextPos

Dim inst As Integer

Dim i As Integer



Const ForReading = 1

Const ForWriting = 2



sSearchText = "cb:TRINGLE"

sReplaceText = "cb:MATERIAL"



sFileName = "C:\XMLtest\export.xml"

'Create instance of FileSystemObject.

Set objFSO = CreateObject("Scripting.FileSystemObject")

'Set objFile = objFSO.OpenTextFile(sFileName, ForReading)

'read entire contents of file, save to strText variable

strText = objFile.ReadAll

objFile.Close

        



'User Settings: replaces instances 1 and 4

inst = Array(1, 4)

     

'Make a for-each loop to skip until the given instance

For Each i In inst

    NextPos = 1

     

    Do While i > 0

      FirstPos = InStr(NextPos, strText, sSearchText, vbTextCompare)

       NextPos = FirstPos + Len(sSearchText)

       i = i - 1

    Loop

    

    strText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)

Next i

Set objFile = objFSO.OpenTextFile(sFileName, ForWriting)

objFile.WriteLine strText

objFile.Close



End Function

I get a compile error on 'For Each i In inst', "For Each may only iterate over a collection object or array"

[thelonelyghost]

I was afraid that would happen. I realize looking back that I forgot to declare the inst variable. Simple "Dim inst(2)"

If that doesn't solve the issue, replace the line "inst = Array(1,4)" with the following:

inst(1) = 1
inst(2) = 4

Anything?

[ADezii]

Hi. I am receiving an XML file that needs to be 'tweeked' before I can properly import it into to my Access database. I need to replace the first and fourth instance of'cb:TRINGLE'. I am able to replace the first instance of ‘cb:TRINGLE’ in the xml file. My problem now is that I do not want all instances to be replaced. I only want the first and fourth … In the following code you can see that I am able to locate the position of the fourth instance (I think) but I end up with the entire begining of the file missing!

Is there a better way to only replace certain matches with the Replace function?

Function FindAndReplaceXMLText()
Dim sSearchText As String
Dim sReplaceText As String
Dim sFileName As String
Dim sFileText As String
Dim strText As String
Dim strNewText As String
Dim intWhere1 As Integer
Dim FirstPos, NextPos

Const ForReading = 1
Const ForWriting = 2

sSearchText = “cb:TRINGLE”
sReplaceText = “cb:MATERIAL”

sFileName = “C:XMLtestexport.xml”

‘Create instance of FileSystemObject.
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)

‘read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close

‘Search for text in string.
strNewText = Replace(strText, sSearchText, sReplaceText, , 1, vbTextCompare)

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

‘Create instance of FileSystemObject.
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)

‘read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close
FirstPos = InStr(1, strText, sSearchText, 1)
NextPos = FirstPos + 10
FirstPos = InStr(NextPos, strText, sSearchText, 1)
NextPos = FirstPos + 10

strNewText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)

Set objFile = objFSO.OpenTextFile(sFileName, ForWriting)

objFile.WriteLine strNewText
objFile.Close

End Function

Can someone please help me with this?!

Just subscribing, will return later.

[vgnadeau]

Now I get a compile error "Expected Array" on inst(1) = 1

Ignore this message. I was able to get rid of the compile error.

[vgnadeau]

Ok. Here's my code now.

Function FindAndReplaceXMLText()
Dim sSearchText As String
Dim sReplaceText As String
Dim sFileName As String
Dim strText As String
Dim FirstPos, NextPos
Dim intLength As Integer
Dim i As Variant
Dim inst(2) As Integer

Const ForReading = 1
Const ForWriting = 2


sFileName = "C:\XMLtest\export.xml"
'Create instance of FileSystemObject.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)
'read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close
        
sSearchText = "cb:TRINGLE"
sReplaceText = "cb:MATERIAL"

'User Settings: replaces instances 1 and 4
inst(1) = 1
inst(2) = 4
'Make a for-each loop to skip until the given instance
For Each i In inst
    NextPos = 1
     
    Do While i > 0 And i < 3
        FirstPos = InStr(NextPos, strText, sSearchText, vbTextCompare)
        NextPos = FirstPos + Len(sSearchText)
        i = i + 1
        
    Loop
    If i < 4 Then
        strText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)
    End If
Next i
Set objFile = objFSO.OpenTextFile(sFileName, ForWriting)
objFile.WriteLine strText

objFile.Close

End Function

It does replace the fourth instance of cb:TRINGLE but removes all text before ... So I end up with this

>
</cb:MATERIAL>
The data after is still there, which is good.

Could you look at this again please? I'm getting desparate!

[ADezii]

Ok. Here's my code now.

Function FindAndReplaceXMLText()
Dim sSearchText As String
Dim sReplaceText As String
Dim sFileName As String
Dim strText As String
Dim FirstPos, NextPos
Dim intLength As Integer
Dim i As Variant
Dim inst(2) As Integer

Const ForReading = 1
Const ForWriting = 2


sFileName = "C:\XMLtest\export.xml"
'Create instance of FileSystemObject.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(sFileName, ForReading)
'read entire contents of file, save to strText variable
strText = objFile.ReadAll
objFile.Close
        
sSearchText = "cb:TRINGLE"
sReplaceText = "cb:MATERIAL"

'User Settings: replaces instances 1 and 4
inst(1) = 1
inst(2) = 4
'Make a for-each loop to skip until the given instance
For Each i In inst
    NextPos = 1
     
    Do While i > 0 And i < 3
        FirstPos = InStr(NextPos, strText, sSearchText, vbTextCompare)
        NextPos = FirstPos + Len(sSearchText)
        i = i + 1
        
    Loop
    If i < 4 Then
        strText = Replace(strText, sSearchText, sReplaceText, NextPos, 1, vbTextCompare)
    End If
Next i
Set objFile = objFSO.OpenTextFile(sFileName, ForWriting)
objFile.WriteLine strText

objFile.Close

End Function

It does replace the fourth instance of cb:TRINGLE but removes all text before ... So I end up with this

>
</cb:MATERIAL>
The data after is still there, which is good.

Could you look at this again please? I'm getting desparate!

I had a heck of a time incorporating the Replace() Function into selective Find/Replace operations, and due to time constraints threw in the towel. I took a unique approach, using a Text File, and surgically found and replaced the 1st and 4th occurrences of sSearchString with sReplaceString via the hard way. I'll post the partial code below, but simply download the Attachment and copy both Files to the same Directory. Open the Database (Replace_Good.m db):

Private Sub cmdTest_Click()
On Error GoTo Err_cmdTest_Click
Dim objFSO As FileSystemObject
Dim ts As TextStream
Dim sSearchText As String
Dim sReplaceText As String
Dim sFileName As String
Dim lngPosition As Long
Dim intNumOfMatches As Integer
Dim strText As String
Dim strNew As String
Dim lngNewPos As Long
Dim strMsg As String
  
sSearchText = "cb: TRINGLE "
sReplaceText = "cb: MATERIAL"
  
sFileName = CurrentProject.Path & "\Test.txt"

strMsg = "   Open the Debug (Immediate Window) via CTRL+G, and you'll see that only " & _
         "the first and fourth occurrences of" & vbCrLf & "[cb: TRINGLE] have been replaced with [cb: MATERIAL]." & _
         vbCrLf & vbCrLf & "P.S. - Nevermind, I'll Open it for you (LOL)."
  
'Create instance of FileSystemObject.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ts = objFSO.OpenTextFile(sFileName, ForReading)
  
'Read entire contents of file, save to strText variable
strText = ts.ReadAll

'1st position of sSearchText within strText
lngPosition = InStr(strText, sSearchText)
If lngPosition = 0 Then Exit Sub

'Surgically remove sSearchText, replace with sReplaceText, and
'Rebuild the String
strNew = Left$(strText, lngPosition - 1) & sReplaceText & " " & _
               Mid$(strText, lngPosition + Len(sSearchText))

'Increment the Number of Matches and increment the new Starting
'Position for the subsequent Find Operation
intNumOfMatches = intNumOfMatches + 1
lngNewPos = lngPosition + 1

'Look for additional Matches, and continue Looping until either the number
'of Mathces = 4 or until sSearchText is no longer found. At the same time
'change only the 1st and 4th occurrences of sSearchtetxt to sReplaceText
Do
  If InStr(lngNewPos, strText, sSearchText) <> 0 Then
    lngPosition = InStr(lngNewPos, strText, sSearchText)
    intNumOfMatches = intNumOfMatches + 1
      lngNewPos = lngPosition + 1
        If intNumOfMatches = 4 Then     '4th occurrence
          strNew = Left$(strNew, lngPosition - 1) & sReplaceText & " " & _
                   Mid$(strNew, lngPosition + Len(sSearchText))
        End If
  End If
Loop Until intNumOfMatches = 4 Or lngPosition = 0

'Write strNew, not strText, to the New File
Debug.Print strNew

MsgBox strMsg, vbInformation, "Selective Replace"
DoCmd.RunCommand acCmdDebugWindow

Exit_cmdTest_Click:
    Exit Sub

Err_cmdTest_Click:
    MsgBox Err.Description, vbExclamation, "Error in cmdTest_Click()"
    Resume Exit_cmdTest_Click
End Sub

[vgnadeau]

Thank you ... you are my hero ;)