Progress Bar not accurate

[anujkmehrotra]

Hi,

I'm making a code to run a Progress Bar from different forms and as per their conditions.

Have two forms:
1- Form1="frmProgressMeter"
2- Form2="frmDatabaseStwitcher"
3- Module1=for Functions

On frmDatabaseStwitcher, the code for Progress Bar is:
-----------
Option Compare Database
Option Explicit
Private Declare Sub sapiSleep Lib "kernel32" _
Alias "Sleep" _
(ByVal dwMilliseconds As Long)

Sub OpenProgressBar(nTopLimit As Long, strCaption As String)
If nTopLimit > 0 Then
DoCmd.OpenForm "FrmProgressMeter", OpenArgs:=strCaption
Forms("FrmProgressMeter").TopLimit = nTopLimit
End If
End Sub

Function SetProgressBar(nCurrent_Pos As Long) As Long
If IsLoaded("FrmProgressMeter") Then
Forms("FrmProgressMeter").Current_pos = nCurrent_Pos
SetProgressBar = Forms("FrmProgressMeter").Current_pos()
End If
End Function

Sub CloseProgressBar()
If IsLoaded("FrmProgressMeter") Then
Forms("FrmProgressMeter").CloseMe
End If
End Sub

Sub sSleep(lngMilliSec As Long)
If lngM
illiSec > 0 Then
Call sapiSleep(lngMilliSec)
End If
End Sub

------------

Code to run Progress Bar with Condition is:

----------
Private Sub cmdDisconnect_Click()
On Error GoTo Err_cmdDisconnect_Click

Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strDatabaseName As String
Dim File As String
Dim retval
Dim NOS As Long 'No of steps
Dim n As Long 'Total Steps

Set dbs = CurrentDb()
File = "Data" & Format(StartDate, "yy") & Format(EndDate, "yy") & ".accdb" '(Output = Data1516.accdb)
strDatabaseName = Folderpath & "\" & File

Me.lblStatus.Caption = "Connecting to current database. Please wait..."
DoCmd.Hourglass True
Me.CmdClose.Enabled = False
Me.cmdConnect.Enabled = False
Me.Dbase.Enabled = False
Me.CmdDisconnect.Enabled = False
retval = SysCmd(acSysCmdSetStatus, "Connecting to current database")

OpenProgressBar 100, "Completed"

NOS = dbs.TableDefs.count
For n = 1 To 100
sSleep 10
SetProgressBar n + NOS
Next n

For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = ";DATABA
SE=" & strDatabaseName & (";PWD=zujan")
tdf.RefreshLink
End If

SetProgressBar n + NOS
Next tdf
sSleep 1000
CloseProgressBar

Me.lblStatus.Caption = "Done."
DoCmd.Hourglass False
retval = SysCmd(acSysCmdClearStatus)

MsgBox "The Auto Evolution database is now connected with " & _
"'" & File & "'.", vbInformation, "Connection Successful"
DoCmd.Close acForm, Me.NAME

Exit_cmdDisconnect_Click:
Exit Sub

Err_cmdDisconnect_Click:

DoCmd.Hourglass False
If Err.Number <> 2467 Then
MsgBox ("Unable to execute database switch now."), vbCritical, "Error"
Me.CmdClose.Enabled = True
Me.cmdConnect.Enabled = True
Me.Dbase.Enabled = True
Me.CmdDisconnect.Enabled = True
Resume Exit_cmdDisconnect_Click
End If
End Sub
-------------

Problem:

This code is working in two ways:

If I go with "SetProgressBar n / NOS" then progress bar shows 2% and then connecting process time.
Or
If I go with "SetProgressBar n + NOS" then progress works till 100% but then connecting process time.
Also
SetProgressBar (n / NOS) * 100 but then connecting process time.

Any assistance will be appreciable.

 

[Frothingslosh]

So what is going wrong here, and what error messages are you getting?

Also, if you'd prefer, I actually have a couple progress meter classes I posted HERE that you could use.

Edit: Also, when posting code, please use the CODE tags. They preserve indentation and help make the code far more legible.

 

[anujkmehrotra]

No error message coming, but progress completes 100% first and then database connecting. They should work along with.

It should be like 100% complete means work done.

 

[Frothingslosh]

If you could edit that to use the code tags - [ code ] and [ /code ] without the spaces - and proper indentation that would help immensely, as I'm trying to do this in between coughing up a slew of reports at work and that block of text kind of runs together.

 

[anujkmehrotra]

Can you suggest any solution of my problem.

Asking for help....

 

[Frothingslosh]

And as I said, if you can please repost the code using proper indentation and code tags, I'll be happy to take a look through it. It really does help make some problems jump out at you.

 

[pbaldy]

I restored this thread, as threads with responses should generally not be deleted. I'll also close it, as the discussion was continued here:

http://www.access-programmers.co.uk/forums/showthread.php?t=276140