Progress Bar from Windows API

Hi nschultz,

Status Bar:

The following are routines written in a form called Status Bar:

------------------
Option Compare Database
Option Explicit

Dim Stat As ProgressBar           ' An pointer to MyStatusBar
Dim CurrentProgressValue As Long  ' Holds Current value for the progress
Dim InProgress As Boolean         ' Is set to true before the process begins

Private Sub Form_Current()
    ' Notice that after the termination of your process, the pass through this Sub.
    ' Therefore, it is neccessary to stop monitoring, if it was not done yet...
    If InProgress And CurrentProgressValue >= Stat.Max Then
        InProgress = False
        Stat.Value = GetMaxValue
        DoCmd.RepaintObject
        Me.TimerInterval = 0
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    InProgress = False
    Set Stat = Me!MyStatusBar.Object
End Sub

Private Sub Form_Timer()
    ' In your application, you should get some REAL value that represents the
    ' actual progress of your routine.
    ' If you make a query, which you want to monitor, then it is reccomended that
    ' you set the query result to a Query or a Table. This way, you can set a routine
    ' that will look at the result and return a value (such as the number of records
    ' already created).
    ' the command should look something like the following:
    '
    ' CurrentProgressValue = GetCurrentQueryCurrRecords
    '
    ' The following command is made to emulate the progress in this example
    '
'    Debug.Print "CurrentProgressValue=" & CurrentProgressValue
'    Debug.Print "Stat.Min=    " & Stat.Min
'    Debug.Print "Stat.Max=    " & Stat.Max
    If CurrentProgressValue < Stat.Max Then
        ' Get some progress...
        Stat.Value = CurrentProgressValue
    Else
        ' The routine have reached it's Max Value
        ' Therefore, set the bar to it's Max Value
'        Stat.Value = Stat.Max
        ' and stop monitoring the progress
'        InProgress = False
'        Me.TimerInterval = 0
    End If
    DoCmd.RepaintObject
End Sub


Private Sub StartTheProcess_Click()

    ' Initialize InProgress, Bar-Min, Bar-Max and CurrentProgress values...
    InProgress = True
    CurrentProgressValue = GetMinValue       'See the routine below
    Stat.Min = GetMinValue           'See the routine below
    Stat.Max = GetMaxValue           'See the routine below
   
    'and make sure to monitor the process every half of a second...
'    Me.TimerInterval = 500
    Me.Refresh
    ' Now it's o.k. to start the procedure
    DoMyRoutine                              'See the routine below
   
End Sub

' The following GetCurrentQueryCurrRecords function is a sample function to return
' the current RecordCount (total records) in a Query or a table
Private Function GetCurrentQueryCurrRecords() As Long
    Dim DBs As Database
    Dim Rst As Recordset
    Dim strSQL As String
   
    ' Replace qMyQuery to the actual name of your query or table name
    strSQL = "SELECT * FROM qMyQuery"
    Set DBs = CurrentDb
    Set Rst = DBs.OpenRecordset(strSQL)
    Rst.MoveLast
   
    GetCurrentQueryMaxRecord = Rst.RecordCount
   
    Rst.Close
    Set DBs = Nothing

End Function

Private Function GetMinValue() As Long
    ' This function returns the Min-Value of the status bar.
    ' You may use it to set any value which is suitable to your needs...
    GetMinValue = 1
End Function

Private Function GetMaxValue() As Long
    ' This function returns the Max-Value of the status bar.
    ' You may use it to set any value which is suitable to your needs...
    GetMaxValue = 1000
End Function

' Use the following SUB to execute your query...
Private Sub DoMyRoutine()
    Dim i As Long, j As Long
   
    j = 1
'    Debug.Print "Me.TimerInterval=" & Me.TimerInterval
    For i = Stat.Min To Stat.Max
        If j > 20 Then
            j = 1
        End If
'        Debug.Print "j = " & j
        j = j + 1
        CurrentProgressValue = i
        Form_Timer
    Next i
    Me.Refresh
End Sub
------------------------------------

On the form, place a ActiveX control with the following parameters:
OLE Class: ProgCtrl
Class: MSComctlLib.ProgCtrl.2


Hope this helps,

Nosterdamus

Notice that the Sub StartTheProcess_Click() procedure is linked to a button called StartTheProcess which I created in the form for test purposes only. In your app, you can delete this sub.

Nosterdamus

I suggest that you look at the MS Access Help for the TransferText action, it is possible that it would let you accomplish what you need much faster than manipulating the text file your-self via code.

Nosterdamus

P.S. Hope this is the last comment I have for the moment... ;-)

Thanks Nosterdamus, is there no way to do this without an active-x control (direct from wondows API)

Of course when I spell something wrong it posts - eg "windows" not wondows.

Hi nscultz,

None that I know of (still, it doesn't say that there isn't one)...;)

Nosterdamus

Hi nscultz

I can send you an example using the Microsoft Progressbar Control that comes with Access 2000

Let me know your email address and will send to you

Cheers
Neil

I have 97, but if it will work send it to ngfschulz@yahoo.com

Testing 123

Testing 345
678

Testing '

Testing ?

Testing - _ / , ! ? @ *

Thanks Neil. Ive been avoiding activex as users arent too computer literate and its a pain explaining how to register control. I may look for some code to register control on first open. Nice sample,simple clean code.

Hi nschulz,

I'd appriciate it very much if you could describe in few words how the solution is working.

nmilmine,
You are more than welcome to add your own explanation as well.

Thanx,

Nosterdamus

Hi nosterdamus:
Im near 300 hours on this application Im writing
and the progress bar will be added in at the very end for flash but its not a big deal for me right now. To date Ive got about 140 SQLs stuffed into modules and Im exporting 6 different file types from each of these so it will take some time to think about the easiest way to get the progress bar into these routines.I actually found some code to create and run a progress bar from the windows API but quite frankly its over my head (only been working with VBA for a year).Anyways thanks for posting your code, I will have a closer look at it when the time comes and If I use it Ill post you some points.
Norm

PS EE still not reading quotation marks.