Re: Replace() problems

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

From: McKirahan (News_at_McKirahan.com)
Date: 12/02/04 

Date: Thu, 02 Dec 2004 19:18:59 GMT

"McKirahan" <News@McKirahan.com> wrote in message
news:kKIrd.599767$mD.374027@attbi_s02...
> "Scottie Hannigan" <Scottie.Hannigan@wanadoo.fr> wrote in message
> news:41af4f90$0$9029$8fcfb975@news.wanadoo.fr...
> > Hi,
> > I have a file which is a list of French first-names in four CSV-type
> > columns
> >
> > Agnès-Céline;Agnès Céline;AGNES-CELINE;AGNES CELINE
> > Pat;Pat;PAT;PAT
> > etc
> >
> > The first column is correctly spelt.
> > But 2nd 3rd and 4th columns are mis-spellings.
> > 2=No hyphen. 3=Block capitals. 4=Block capitals and no hyphen.
> >
> > The idea is to use this first-names file to correct another file of
names
> > and adresses where first-names may be mis-spelt..
> > The idea is to scan through the adresses file line by line checking for
> the
> > prescence of strings identical to data in columns 2, 3 or 4.
> > Any such data should then be replaced by the data from column 1.
> >
> > This works BUT !! ...
> > Incidences of PATTON (as in PATTON STREET) were getting replaced by
> PatTON.
> > etc.
> > BANNER became BAnneR, (i.e. the ANNE rplaced by Anne.)
> >
> > So I decided to check for whole words, thinking that as my data in the
> > adress file is tab-separated I could look for
> > chr(9)&ANNE&chr(9) and replace that with chr(9)&Anne&chr(9)
> >
> > But that doesn't work and I can't figure out why.
> > Is it Unicode/Ascii ?
> > Is there no way to use Replace() on only whole words ?
> >
> > It's driving me nuts.
> > Almost there but not quite!
> > Here's the script.
> > TIA
> >
> > Scottie.
> > ---------------------
> > 'Create a File System Object
> > on error resume next
> > Const ForReading = 1, ForWriting = 2, ForAppending = 8
> >
> > Dim fso
> > Set fso = CreateObject("Scripting.FileSystemObject")
> > 'Get the file contents
> > Dim MyPrenoms
> > Set MyPrenoms = fso.OpenTextFile( "C:\VBS
STUFF\prénoms.csv",ForReading,
> > False)
> >
> > 'Loop through counting the lines
> > LineCount=0
> > Dim MyArray (4000, 4)
> >
> > Do While Not MyPrenoms.AtEndOfStream
> > MyLine = MyPrenoms.readLine
> >
> > 'msgbox Myline
> > LineCcontents = Split(MyLine, ",", -1, 1)
> > 'MSGBOX LineCcontents(0) & LineCcontents(1) & LineCcontents(2)&
> > LineCcontents(3)
> > MyArray(LineCount,0) = LineCcontents(0)
> > MyArray(LineCount,1) = LineCcontents(1)
> > MyArray(LineCount,2) = LineCcontents(2)
> > MyArray(LineCount,3) = LineCcontents(3)
> >
> > ' msgBox MyArray(LineCount,0) & MyArray(LineCount,1) &
> > MyArray(LineCount,2) & MyArray(LineCount,3)
> >
> > LineCount = LineCount + 1
> > Loop
> >
> > msgbox "LineCount Prénoms : " & LineCount
> >
> >
> > Dim MyFileAdressesIn
> > Set MyFileAdressesIn = fso.OpenTextFile("C:\VBS
STUFF\lapat1.txt",
> > 1, False)
> >
> > Set MyFile = fso.GetFile("C:\VBS STUFF\lapatOut.txt")
> > MyFile.Delete
> > Dim MyFileAdressesOut
> > Set MyFileAdressesOut = fso.OpenTextFile ("C:\VBS
> > STUFF\lapatOut.txt", ForAppending, True)
> >
> > do while RL < 20 '---------for testing
> > MyAdresse = MyFileAdressesIn.readLine
> > RL = RL + 1
> > MyOldAdresse = MyAdresse
> > For i = 0 to Linecount
> > For j = 1 TO 3
> > ' If Instr(1,Myadresse, chr(9) &trim( MyArray(i,j) )&
> > chr(9), 0 ) then
> > ' MsgBox "Found" & vbcrlf & MyAdresse & vbcrlf &
> > MyArray(i,j)
> > ' End if
> >
> > MyAdresse = Replace( MyAdresse, _
> > chr(9) & MyArray(i,j) & chr(9), _
> > chr(9) & MyArray(i,0) & chr(9), 0 )
> >
> > MsgBox MyOldAdresse & vbcrlf & _
> > MyAdresse & vbcrlf & _
> > chr(9)& MyArray(i,j)& chr(9)& vbcrlf & _
> > chr(9)& MyArray(i,0)& chr(9)
> >
> > Next 'i
> > Next 'j
> > MyFileAdressesOut.writeline(MyAdresse)
> >
> > Loop
> >
> > 'Cleanup
> >
> >
> > MyMyPrenoms.Close
> > MyFileAdressesIn.Close
> > MyFileAdressesOut.Close
> > Set MyFileContents = Nothing
> > Set fso = Nothing
> > msgbox "Finished" & "LineCount " & LineCount & vbcrlf & _
> > " i " & i & vbcrlf & _
> > " j " & j
> >
> >
>
> Is "the adresses file" a CSV file?
> If so, which element is the name?
>
> You can use a Regular Expression to isolate whole words.
>
>

Here's a solution that replaces "Bad" names with "Good" names as long as
there is a space on either side (or if its at the begging or end of the
line). Watch for word-wrap.

'****
'* This Visual Basic Script (VBS) program does the following:
'* 1) Read a CSV into an array; display the record count.
'* (actually its a Semicolon-Separated-Values) file.
'* Each record contains 4 versions of a name;
'* The first name is "Good", the other three are "Bad" names.
'* 2) Read a Name and Address file into an array.
'* 3) Examine each row replacing each "Bad" name with the "Good" name.
'* 4) Write each record to a new Name and Address file.
'* 5) Display the number of "Bad" names that were replaced.
'****
    Option Explicit
   '*
   '* Declare Constants
   '*
    Const cVBS = "prénoms.vbs"
    Const cCSV = "prénoms.csv"
    Const cOT1 = "lapat1.txt"
    Const cOT2 = "lapatOut.txt"
    Const cFOL = "C:\VBS STUFF\"
   '*
    Const ForReading = 1
    Const ForWriting = 2
    Const ForAppending = 8
   '*
   '* Delare Variables
   '*
    Dim arrCSV
    Dim intCSV
    Dim strCSV
    Dim arrNAM
    Dim intNAM
    Dim strNAM
    Dim intPOS
    Dim arrOT1
    Dim intOT1
    Dim strOT1
    Dim intOT2
    Dim strOT2
   '*
   '* Declare Objects
   '*
    Dim objFSO
    Dim objOTF
    Dim objOT1
    Dim objOT2
   '*
   '* Assign Objects
   '*
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objOTF = objFSO.OpenTextFile(cFOL & cCSV,ForReading)
    Set objOT1 = objFSO.OpenTextFile(cFOL & cOT1,ForReading)
    Set objOT2 = objFSO.OpenTextFile(cFOL & cOT2,ForWriting,True)
   '*
   '* Read Prénoms
   '*
    strCSV = objOTF.ReadAll()
    arrCSV = Split(strCSV,vbCrLf)
    MsgBox "LineCount Prénoms : " & UBound(arrCSV) + 1,vbInformation,cVBS
   '*
   '* Read the input file into an array
   '*
    strOT1 = objOT1.ReadAll()
    arrOT1 = Split(strOT1,vbCrLf)
    intOT2 = 0
   '*
   '* Process each Name and Address record
   '*
    For intOT1 = 0 To UBound(arrOT1)
        strOT2 = " " & arrOT1(intOT1) & " "
       '*
       '* Process each Good/Bad Name record
       '*
        For intCSV = 0 To UBound(arrCSV)
            arrNAM = Split(arrCSV(intCSV),";")
            strNAM = arrNAM(0)
           '*
           '* Find "Bad" names and replace them with the "Good" name
           '*
            Do
                For intNAM = 1 To UBound(arrNAM)
                    intPOS = InStr(strOT2," " & arrNAM(intNAM) & " ")
                    If intPOS > 0 Then
                        strOT2 = Left(strOT2,intPOS) & strNAM &
Mid(strOT2,Len(strNAM)+intPOS+1)
                        intOT2 = intOT2 + 1
                    End If
                Next
                If intPOS = 0 Then Exit Do
            Loop
        Next
       '*
       '* Write out the new Name and Address record
       '*
        strOT2 = Mid(strOT2,2,Len(strOT2)-2)
        objOT2.WriteLine(strOT2)
    Next
   '*
   '* Destroy Objects
   '*
    Set objOTF = Nothing
    Set objOT1 = Nothing
    Set objOT2 = Nothing
    Set objFSO = Nothing
   '*
   '* Finished
   '*
    MsgBox "Changed Prénoms : " & intOT2,vbInformation,cVBS

Quantcast