Hey there,

I want a button that stops the current code.

eg. I have build a search function but when it searches on a rather large drive then it does not stop before all items are listed. So I would like to have a stop button.

Or does anybody have suggestions how to solve such a thing properly

I know it can be done with send keys "Ctrl Break", but I have noticed that you have to push that frequently before it stops. I can only imagine that you have to push the button frequent before it works. That is not an option imo.

Regards,
Bjorn

First what is the code that you are using to send the search? My thinking is that you would put the code in a loop and have the option to send an interupt to the loop. So every time the code loops, it checks for the interupt condition.



mmcdonal

Look it up at: http://wrox.books24x7.com

There you go!

Thanks man!! So basicly at the end of my loop I let vba check if at the form itself something is activated!

Something like

If Forms!FileSearch!Stop.value = 0 Then
: Goto THE_END
End If

THE_END:
End Function

Thanks again, good call

I think so. The problem might be if the code checks the value once at the beggining on the loop, and then can't check it again until after the sub has run. So within each loop, you will have to take the variable, like you said:

Do Until rs.EOF
     'Check 100 recrds
     If Me.Stop.value = 0 Then
        Exit Sub
        'or package results so far
     End If
Loop

It depends on what search is doing. I would open a recordset and then search 100 records, then check the value, then search 100 more, etc. If the code just executes a search without parsing the records, then it might not work.

So create a table to send results to, then parse 100 records and send results, then check the value, then parse another 100 etc unless the stop value is ancountered. Then close the recordset and open the report of continuous form on the results accumulated so far, along with a record comparison, like 80,000 of 500,000 records searched kind of thing.



mmcdonal

Look it up at: http://wrox.books24x7.com

Man, lots of spelling mistakes there. I am fat-fingered today.

mmcdonal

Look it up at: http://wrox.books24x7.com

Does not work.... I cannot change the form while the code runs.

Well I am doing this, kinda complicated... Maybe a bit onconventional and sloppy but I am learning.

I set a drive, wich i let search.
Then it returns the outcome on a form
On the form you can choose to search the whole drive or just the root
When you go for the whole drive, i drop it in a loop and let check table for duplicates.

Public Function GetFiles()


Dim Naam, Naam2, table_name, Veld, path, NieuwPad, Cur_Form, KB1, KB2, Zoek1, Zoek2, Pos
Dim AC_LIST As Recordset
Dim oFSO As Object
Dim folder As Object
Dim subfolders As Object
Dim GrooteFile As Double
Dim GrooteFolder As String

NieuwPad = 0

ZOEKEN:

    If NieuwPad = 0 Then

        If IsNull(Forms!F_Get_Files!DRIVE) Or (Forms!F_Get_Files!DRIVE) = "" Then
            path = "H:"
        Else
            path = Forms!F_Get_Files!DRIVE & "\"
        End If
            table_name = "Get_Files"
            Cur_Form = "F_Get_Files"

   Else
   path = NieuwPad
   End If

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder(path)
    Set subfolders = folder.subfolders
    Set AC_LIST = CurrentDb.OpenRecordset(table_name)

    DoCmd.GoToRecord acDataForm, (Cur_Form), acNewRec

On Error GoTo err_mgr
For Each i In subfolders
    Forms!F_Get_Files!Pad = "Folder op " & (path) & "" & Mid(i, 1 + InStrRev(i, "\"), Len(i) + 1 - InStrRev(i, "\"))
    Forms!F_Get_Files!Naam = "<KLIK HIER OM DEZE FOLDER TE SELECTEREN OM TE SCANNEN>"

        If Forms!F_Get_Files!Check36.Value = True Then
            GrooteFolder = i.Size


                 If IsNull(GrooteFolder) Or (GrooteFolder) = "" Then
                     GrooteFolder = 0
                 Else
                  KB2 = Format(GrooteFolder / 1024, "##,###")
                         If IsNull(KB2) Or (KB2) = "" Then
                     KB2 = 0
                     Forms!F_Get_Files!Naam = "<DEZE FOLDER IS LEEG>"
                        End If
                    End If
                Forms!F_Get_Files!KB = (KB2)
        End If


    DoCmd.GoToRecord acDataForm, (Cur_Form), acNext

 Next

        Naam = Dir(path)
: GoTo FirstLoop

        Do Until Naam = ""
        Naam = Dir
        File = (path) & (Naam)
FirstLoop:
        Exten = Right(Naam, 3)

        If Forms!F_Get_Files!Check36.Value = True Then
            If Naam = "" Then
                GrooteFile = 0
            Else
                GrooteFile = FileLen(File)
                KB = Format(GrooteFile / 1024, "##,###")
                    If IsNull(KB) Or (KB) = "" Then
                        KB = 1
                    End If
            End If
        End If

    If IsNull(Naam) Or (Naam) = "" Then
: GoTo Weiter_machen
    Else
    Forms!F_Get_Files!Pad = "File op " & (path) & Mid(i, 1 + InStrRev(i, "\"), Len(i) + 1 - InStrRev(i, "\"))
    Forms!F_Get_Files!Naam = (Naam)
    Forms!F_Get_Files!Ext = (Exten)
    Forms!F_Get_Files!KB = (KB)
    DoCmd.GoToRecord acDataForm, (Cur_Form), acNext
    End If


Loop
Weiter_machen: 'Jawohl her commandant Bjorn
If Forms!F_Get_Files!GEHELE.Value = True Then
'msg = MsgBox("DONE")

    Set AC_LIST = CurrentDb.OpenRecordset(table_name)

            With AC_LIST
            Aantal = .RecordCount
            Do While Not .EOF

            Sjaak = DLookup("[Klaar]", "Q_MORE", "[Klaar] = 0")


            If Sjaak <> 0 Then
: GoTo THE_END
            End If


                Pad = .Fields![Pad]
                Naam2 = .Fields![Naam]
                Klaar = .Fields![Klaar]

    If Naam2 = "<KLIK HIER OM DEZE FOLDER TE SELECTEREN OM TE SCANNEN>" And Klaar = False Then

                .Edit
                ![Klaar] = True
                .Update

        Lengte = Len(Pad)
        NieuwPad = Mid(Pad, 11, Lengte) & "\"
        path = NieuwPad

' Begin opnieuw - ZOEKEN Begint weer van start positie
: GoTo ZOEKEN

    End If

    If Forms!F_Get_Files!Stop.Value = True Then
: GoTo THE_END
    End If

    .MoveNext
    Loop
    End With

End If



err_mgr:
    erreur = Err
' MsgBox Err & " - " & Err.Description
    Resume Next
    If Err = 70 Then Resume Next
    'Stop
    'Resume Next
THE_END:

DoCmd.Close ("F_Stop")
msg = MsgBox("DONE!")

End Function

It looks like you are recursing folders and subfolders here, and this would be the place to add code to count to 100, and then check the value on the form. I would do something like this, after adding a text box to display the number of records counted so far.

Do you need help with the actual code?





mmcdonal

Look it up at: http://wrox.books24x7.com

Can you change the form if the code runs on a module? Also, can you pause the code for one/half second each loop to check the state? Use a toggle button.

mmcdonal

Look it up at: http://wrox.books24x7.com

I was thinking yesterday night... I always have the same procedure, I go fetch the (root) dir (and files) and then fetch all subfolders (and the files per folder), mark them in a table as fetched. And when fetched all it starts again with the first new root found. So on and on till every folder is scanned.

So my idea is to after the last subfolder is scanned and before it sets a new (root) folder to build in a moment of rest. Like you said. I let him count the items and that is my total and then do a (For i = number to .recordcount) ,,, like you mentioned here. Let the tool run then reset the root and counter. So basicly in stead of 100, the new root folder is my point of rest.

I think that has a good change of succes. I will figure that out today.

Thanks for input

This is a good way to learn vba