Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
Discussion GroupsFormsForms ProgrammingQueriesModules / DAO / VBAReports / PrintingMacrosDatabase DesignSecurityConversionImporting / LinkingSQL Server / ADPMultiuser / NetworkingReplicationSetup / ConfigurationDeveloper ToolkitsActiveX ControlsNew UsersGeneral 1General 2
Access DirectoryToolsTutorialsUser Groups
Related Topics
SQL ServerOther DB ProductsMS OfficeMore Topics ...

MS Access Forum / Modules / DAO / VBA / November 2006

Tip: Looking for answers? Try searching our database.

Application hang

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Steve - 20 Nov 2006 15:20 GMT
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*****
Stefan Hoffmann - 20 Nov 2006 15:34 GMT
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
[quoted text clipped - 5 lines]
>     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 <--
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.