how would a parse out values in a s

[ktucci]

how would a parse out values in a string 2300000 characters long...i would like to parse for the "/TN" in the string and pull the phone number preceeding it and then move onto the next occurence and do the same thing for each occurence...the string looks something like...

any help will be greatly appreciated...thanks..keith

LOCAL 100.00% X 1 X 19.24 19.24 091900 1 U9SAT /TN 845 896-1083 091900 091900 1 RYA /TN 845 896-1086 091900 /TAR 066 /LCC Y41 /LPCA FN, 08-06-99 /LPCX 0698 /LPIC NYC /PCA FN, 08-06-99 /PIC ALN /PICX

 

[JohnYingling]

Use Instr

L = Len(strToParse)
I = 1

Do 
    J = Instr(I,strToparse,"/TN")
    if J = 0 then
        I = L + 1
        Exit Do
    End If
    If J +  12 <= L then
         steTele = Mid(strToParse, J + 3,12)
    End if
    I = J + 15
Loop

Check the 12 and 15. I did not check closely but this is the idea.

http://WWW.VBCompare.Com

 

[MichaelRed]

I think there will be some issues in dealing with a single string of 2.3 MILLION characters. I think I would approach the problem by creating an array of strings of some convenient length(s). One possability might be to read the file one character at a time, adding each char to the current array until the 'Magic' ("/TN&quot sequence is found. Start a new string if / when the seq is found OR some MAX length is achieved (like 1K?). When te BIG string has been chopped into ~ 2000 little strings, just check eack little last three chars. If they match, go get the phone #, Other wise go to hte next. If it matches, and it is long enough to contain the phone #, get it. If it matches - but is not long enough, concatenate enough of the current and previous to ge the phone #. Continue till the end of the array of strings.

If there is a pattern to the spacing of the phone # & the KEY, you could do this more efficiently.


MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over

 

[JohnYingling]

Dim strToparse as string
Do While (gotdata)
    Read block strInput
    if not (atEnd) then
         ParseString  strToParse & StrInput
         strToparse = Right(strInput,14) ' largest that can't contain
    end if
Loop 
End Sub
Sub ParsetString(byval strToParse as string)         
L = Len(strToParse)
I = 1
Do 
    J = Instr(I,strToparse,"/TN")
    if J = 0 then
        I = L + 1
        Exit Do
    End If
    If J +  12 <= L then
         PutTele Mid(strToParse, J + 3,12)
    End if
    I = J + 15
Loop
End Sub

http://WWW.VBCompare.Com

 

[MichaelRed]

I think ktucci has mis-stated the problem slightly. The sample does not follow the pattern of a "preceeding" phone number. It does have the pattern of a following phone number.

The following function will parse the two phone numbers from the sample text file. The second one (following) is a 'test' program which illustrates a way to use the function. I would "GUESS" that the whole process is amenable to an easier (and more accurate) soloution. The 2.3 MILLION character file was probably written by a program. 'Simple' inspection suggests that the "/" charactrer is the record delimiter, with the following non-blank characters denoting the record content (or type) where "TN" is an abreviation for "Telephone Number. Further "Inspection" suggests the format if the file is a 101 Character Header followed by 80 character records whose first character is the "/". The LAST "record" in the sample does not follow this pattern, however we cannot see if this is due to an arbitrary sample selection or it is part of the overall pattern. Since the request appears to be satisfied by the soloution, this specific thread appears to be resolved, and further review of the source information not really warranted.

Public Function basLongStr2StrArray(strFileIn As String) As Variant

    Dim strArray() As String    'Array of little strings
    Dim phnArray() As String    'Array to hold phone #s
    Dim strKey As String * 3    'Temp Holder to look for "Key ("/TN")
    Dim Jdx As Integer          'Index Pointer to strArray
    Dim MyFil As Integer        'File handle

    strKey = "/TN"

    MyFil = FreeFile
    Open strFileIn For Input As MyFil

    ReDim strArray(Jdx)

    Do While Not EOF(MyFil)
        MyChr = Input(1, #MyFil)    'Just grab one
        strArray(Jdx) = strArray(Jdx) & MyChr
        If (right(strArray(Jdx), 3) = strKey) Then
            strArray(Jdx) = Trim(strArray(Jdx))
            Jdx = Jdx + 1
            ReDim Preserve strArray(Jdx)
        End If
        
    Loop
    strArray(Jdx) = Trim(strArray(Jdx))

    Close #MyFil

    Jdx = 0
    ReDim phnArray(Jdx)

    For Jdx = 1 To UBound(strArray)
        phnArray(Jdx - 1) = left(strArray(Jdx), 12)
        ReDim Preserve phnArray(Jdx)
    Next Jdx

    basLongStr2StrArray = phnArray

End Function

Public Function basTstLngStr(MyFilName As String)

    Dim strPhnNum() As String
    
    MyPhns = basLongStr2StrArray(MyFilName)

    ReDim Preserve strPhnNum(UBound(MyPhns))

    For Idx = 0 To UBound(strPhnNum)
        strPhnNum(Idx) = MyPhns(Idx)
        Debug.Print strPhnNum(Idx)
    Next Idx
End Function

MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over

 

[ktucci]

this is the solution that i have come up with...it seems to work on small file when i try it on a string with approx 2 mil chars it does not seem to work...i will try all of the above examples you posted...if anyone has anymore feedback please post it...thanks for all of the help

Private Sub Command2_Click()
Dim length$
Call OpenTextFile("test.txt&quot
Call SaveTextFile("test.txt", "&quot
datstring = OpenTextFile("d10302.dat&quot
getstring1$ = datstring
Text1.Text = length$
Do
On Error GoTo errorhandler
length$ = Len(getstring1$)
Text1.Text = length$
'If length$ < 18 Then
'Exit Do
'End If
tempstring$ = InStr(getstring1$, &quot;/TN&quot
If tempstring$ = &quot;0&quot; Then
Exit Do
End If
getstring1$ = Mid(getstring1$, InStr(getstring1$, &quot;/TN&quot + 6)
getstring2$ = getstring2$ & Left(getstring1$, 12) & &quot;|&quot;
Loop
errorhandler:
'MsgBox &quot;DONE&quot; & getstring2$
Call SaveTextFile(&quot;test.txt&quot;, getstring2$)
End

 

[ktucci]

this is the solution that works for any file fize:

Function OpenTextFile1(xPath As String, sPath As String) As String
Dim a As Integer
Dim fileNum As Integer, fileBuffer As String, tempBuffer As String
If Exists(xPath) = False Then OpenTextFile1 = &quot;BAD PATH&quot;: Exit Function
Form1.Label2.Caption = Str(FileLen(xPath))
fileNum = FreeFile()
Open xPath For Input As #fileNum
Do While Not EOF(fileNum): DoEvents
Line Input #fileNum, getstring1$
Do
Form1.Label1.Caption = a + 1
'On Error GoTo errorhandler
tempstring$ = InStr(getstring1$, &quot;/TN&quot
If tempstring$ = &quot;0&quot; Then
Exit Do
End If
getstring1$ = Mid(getstring1$, InStr(getstring1$, &quot;/TN&quot + 6)
getstring2$ = getstring2$ & Left(getstring1$, 12) & &quot;|&quot;
a = a + 1
Loop
'errorhandler:
Call SaveTextFile(&quot;test.txt&quot;, getstring2$)
Loop
Close #fileNum
End Function