Application hang

G

Guest

Greetings,

I have a problem with a split database when it initializes. The front end
connects to a SQL ODBC connection. I have commented out one line of code and
the app seems to work perfectly. I was just wondering why this one line of
code could be the culprit.

The application hangs at the point marked ?? below.

This is the line of code that I had commented out:

In the Private Sub InitializeApp():
Me.TimerInterval = 3000 - Int((sngEnd - sngStart) * 1000)

Here is the code, for all subs that are related to this problem:

*****Begin Code*****

Private Sub InitializeApp()

On Error GoTo InitErr
Dim sngStart As Single
Dim sngEnd As Single
Dim sDBVersion As String
Dim dtAhead As Date
Dim sMsg As String
Dim iMsgButton As VbMsgBoxStyle
Dim iMsgReply As VbMsgBoxResult
Dim iAttempt As Integer

sngStart = Timer()

dtAhead = DateAdd("m", 2, Now)

bBadVersion = False
iAttempt = 0

DBConnectAttempt:
Me.VersionFeddback = "Verifying database version..."
iAttempt = iAttempt + 1
iMsgReply = 0
Err.Clear
On Error Resume Next
sDBVersion = DLookup("[sValue]", "tblOADConfig", "Name='DBVersion'")
If Err.Number > 0 Then
Select Case Err.Number
Case 3151
'Err 3151 - ODBC Connection failed
Me.VersionFeddback = "Database is unavailable."
sMsg = "The database is currently unavailable. Please try again
later."
Case Else
Me.VersionFeddback = "Database is unavailable."
sMsg = "There was a problem connecting to the database. Please _
try again later."
End Select
sMsg = sMsg & vbCrLf & "Errcode (" & Err.Number & ") " &
Err.Description
sMsg = sMsg & vbCrLf & vbCrLf & "If this problem persists, please
contact _
OAD System support while this message is on the screen."
If iAttempt >= 5 Then
iMsgButton = vbOKOnly
sMsg = sMsg & vbCrLf & "Maximum retry attempts reached. Please
wait _
10 minutes before starting application. Application will
now terminate."
Else
iMsgButton = vbRetryCancel
sMsg = sMsg & vbCrLf & "Click Retry to try to connect to the
database or, _
click Cancel to exit the application."
End If
iMsgReply = MsgBox(sMsg, iMsgButton + vbCritical, "Database
Unavailable")
If iMsgReply = vbRetry Then
GoTo DBConnectAttempt
Else
bBadVersion = True
DoCmd.Close acForm, Me.Name
DoCmd.Quit
End If
Else
If sDBVersion = VERSION Then
Me.VersionFeddback = "Database version " & sDBVersion
'the qryUpdatePaidFor query runs everytime the program is opened
and
'clear the checknum paid and associated fields so that they will
be up for
'payment in the current renewal month
'qryDeletepaymentinfo runs a delete query that will clear that
owner from
'the payment info table so that the owner will appear in the
monthly billing
'processes this is no longer needed and is deleted

DoCmd.SetWarnings False
Me.Feedback = "Capturing payment history for " & Format _
(dtAhead, "mmmm yyyy") & "..."
DoCmd.OpenQuery "qryAppendPaidForHistory", acNormal, acAdd
Me.Feedback = "Preparing to accept payments for " & Format _
(dtAhead, "mmmm yyyy") & "..."
DoCmd.OpenQuery "qryUpdatePaidFor", acNormal, acEdit
Me.Feedback = "Loading Application..."
?? - At this point the app visually hangs once the "Lodaing Application..."
is visible

DoCmd.SetWarnings True
Else
Me.VersionFeddback = "Version does not match database " &
sDBVersion
MsgBox "Incorrect Application version. You are running version "
& _
VERSION & ". The database requires version " &
sDBVersion & _
"." & vbCrLf & vbCrLf & _
"Contact OAD System support. Application will now
terminate.", _
vbOKOnly + vbCritical, "Expired Application Version"
bBadVersion = True
DoCmd.Close acForm, Me.Name
DoCmd.Quit
End If
End If

sngEnd = Timer()

**This is the line of code that when commented out the app wors as expected**
Me.TimerInterval = 3000 - Int((sngEnd - sngStart) * 1000)

InitExit:
Exit Sub

InitErr:
UnexpectedErrorMsg Err, "Application Initialization Error", "An error
occurred _
while attempting to initialize the
application."
blnLoaded = False
bBadVersion = True
Resume InitExit

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Timer()
'Close the form once the time is up
If blnLoaded Then
DoCmd.Close acForm, Me.Name ', acSaveNo
Else
InitializeApp
blnLoaded = True
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
If Not bBadVersion Then
DoCmd.OpenForm "Switchboard"
End If

If blnLoaded Then gbSplashed = True
End Sub

*****End Code*****
 
S

Stefan Hoffmann

hi Steve,
**This is the line of code that when commented out the app wors as expected**
Me.TimerInterval = 3000 - Int((sngEnd - sngStart) * 1000)
Check, wether the value for your interval is to small.
Private Sub Form_Timer()
'Close the form once the time is up
If blnLoaded Then
DoCmd.Close acForm, Me.Name ', acSaveNo
Else
InitializeApp
blnLoaded = True
End If
End Sub
Don't use that kind of program flow. Try something like following, start
the timer when your init method is done:

Private Sub Form_Open()

sngStart = Timer()
InitializeApp
sngStop = Timer

If sngStop-sngStart>NeedMoreDisplayTime Then
TimerInterval = <CalculateIt>
TimerOn = True
End if

End Sub


mfG
--> stefan <--
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top