Loop until, then loop until...?

[ryan.gillies]

Hi everyone

I've been trying to search for some kind of method to do the following task, but so far I've come up with nothing!

I have the following code I've typed up which will scan through a text file to find the first instance of an account number (acc) and write that line into a word document.

Then I want to continue writing lines into the document where Mid(Line, 11, 8) = str1 until Mid(Line, 11, 8) <> str1. This bit is what's tripping me up - can anyone point me in the right direction?

This is what I have so far:

Sub GetAccount(acc As String)
Dim Line As String
Dim str1 As String

str1 = "        "
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set archive = fso.OpenTextFile("I:\test.txt", 1)
 
With archive
    Do Until .AtEndOfStream
    Line = .ReadLine
    If Mid(Line, 11, 8) = acc Then
    Selection.TypeText Line & vbCrLf
    End If
    Loop
End With
 
End Sub

 

[gemma-the-husky]

do you mean you have sections of text file, for consecutive accounts?
try this sort of thing (aircode/pseudocode)

dim lastacc as string
dim thisacc as string

lastacc=""
thisacc=""
opentextfile
while not textfile.eof
     readnextline
     thisacc = readaccno
     if thisacc<>lastacc and lastacc<> then
         'deal with new account
         lastacc= thisacc
     else
         'deal with item for same account
     end if
wend
closetextfile

 

[ryan.gillies]

Thanks Dave, I'm not very familiar with While statements, but I'll have a play and see if I can make it do what I want!

 

[ryan.gillies]

Ok I wasn't really having much luck with the While statement, so I took what I think your priniciple was Dave and came up with the following:

Dim fso As Object
Dim archive As Object
Dim archivefile As String
Dim strline As String
Dim acc, lastacc, thisacc As String
Dim str1, str2, str3 As String
str1 = Right(acc, 7) & " "
str2 = "        "
str3 = " A.L.P.F"
acc = txtAcc.Text
archivefile = txtFile.Text
Set fso = CreateObject("Scripting.FileSystemObject")
Set archive = fso.OpenTextFile(archivefile, 1)
With archive
    Do
    strline = .ReadLine
    thisacc = Mid(strline, 11, 8)
 
    If thisacc = acc Then
    Selection.TypeText strline & vbCrLf
    lastacc = acc
 
    ElseIf lastacc = acc Then
 
    If thisacc = str1 Or thisacc = str2 Or thisacc = str3 Then
    Selection.TypeText strline & vbCrLf
    Else
    lastacc = ""
    End If
 
    End If
    Loop Until .AtEndOfStream
 
End With
MsgBox ("Archive extracted.")
Set fso = Nothing
Set archive = Nothing

It works fine on a smaller text file when I scan through it - the criteria I have in place extracts exactly the right lines and no more than that. The catch is that the files I want to be able to scan through and extract lines from are over 100mb in size - my computer just hangs on me when I attempt to use it.

The text files are on a network share, and I understand that copying them to a local drive could speed things up. However system policies in place here at the office mean we don't have access to shared drives. Additionally there is sensitive data in the files so having copies on every machine is also not acceptable.

Does anyone have any thoughts on how I might speed it up?

 

[gemma-the-husky]

i doubt if it is not working, and the netwrok share probably isn't an issue. it's just reading lines one at a time, and there is a lot of lines so it will take a fair while.

put a counter in there to count the lines read and output.

importantly put a DoEvents immediately before the loop statement.

maybe add docmd.hourglass true

now you should be able to add fields to your form to show the counts, so you can see the progress made. The DoEvents allows access time to do other things, such as refresh the display - instead of just appearing to "hang"

eg - I'm am sure if you press ctrl-break while it is running, it will say "program interrupted", and take you to where it has readched. You can do this, step through a few lines of code, then carry on running it, if you want.

 

[ryan.gillies]

Hi Dave

Thanks so much for your help - it all proved invaluable and the code is working like a charm now.

I have another project I'm also working on, which I've also run into a Loop problem on, so I'm hopeful somebody may be able to help me with this one as well.

Here is the part of my code causing some frustration:

    Dim bodyAcc As String
    
    Set rs1 = db.OpenRecordset("tAccount", dbOpenDynaset)
    rs1.Filter = "FileID = " & Forms!fAnalyse!FileID & ""
    Set rs2 = rs1.OpenRecordset
 
    With rs2
    Do Until .EOF
        bodyAcc = bodyAcc & ![Account]
        'bodyAcc = bodyAcc & ![Account] & "(" & ![AccType] & ")" & vbCrLf & ![LSD] & " - " & ![LCD] & vbCrLf & _
        '![Source] & vbCrLf
    Loop
 
    End With
 
    rs1.Close
    rs2.Close
    Set rs1 = Nothing
    Set rs2 = Nothing

I've used this same code in a number of other places (even for the same recordset in another place) and it works fine. However on this particular instance there is only one record in the recordset, and it continues to loop, never reaching EOF. I have absolutely no idea what might be causing it!

Are there any common errors that can cause a recordset of one record to endlessly loop despite the Until .EOF? Am I overlooking something obvious?

Thanks again forum peeps for all your time and effort!

 

[gemma-the-husky]

in this bit

Do Until .EOF
bodyAcc = bodyAcc & ![Account]
'bodyAcc = bodyAcc & ![Account] & "(" & ![AccType] & ")" & vbCrLf & ![LSD] & " - " & ![LCD] & vbCrLf & _
'![Source] & vbCrLf
rs2.movenext
Loop

you STILL need an rs2.movenext before the loop

eof doesn't become true until after you attempt to read past the last record. As it stands you are not moving from the last record. I am sure that will make sense.

 

[ryan.gillies]

That makes perfect sense Dave!

I have a .movenext in every other part of my code where its needed, so I'm not sure how exactly that one escaped me! Thank you again, its amazing what a fresh pair of eyes can do.