Hourglass Won't Display

[scotthutchings]

I am trying to display the hourglass while the user waits for a complex form to load. The problem is that the hourglass does not actually display. The SysCmd messages display appropriately, but not the hourglass does not. I have tried to insert DoEvents directly following the hourglass command but this appears to have not effect. If I run the code, line by line, in break mode than it will appear but even if I put a code break after the hourglass line, the hourglass does not appear. This seems to rule out that it is just happening too quickly. I have also eliminated the Docmd.Hourglass (False) line altogether and the hourglass does not appear until after the form is completely loaded. Any idea what I have done?

Private Sub hypEstimating_Click()
On Error GoTo ErrorHandler
    Dim AccessGranted As Integer
    Dim AccessAllRecords As Integer
    Dim rs As Recordset
    Dim UserName As String
    Dim RetVal As Variant
    [COLOR=darkred]DoCmd.Hourglass (True)
    DoEvents[/COLOR]
    RetVal = SysCmd(4, "Verifying Access Rights...")
    UserName = Me.txtUserName
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Employee " & _
        "WHERE Employee ='" & UserName & "'")
    AccessGranted = rs!EmployeeAccessEstimating
    If AccessGranted = -1 Then      'Access rights to estimating granted
        RetVal = SysCmd(4, "Loading Estimating Data...")
        If rs!EmployeeAccessAllRecords = -1 Then 'access unrestricted
            DoCmd.OpenForm "Bid - Master Form"
            Forms![Bid - Master Form]![RecordAccessRights] = "Unrestricted"
            Forms![Bid - Master Form]![txtUserName] = UserName
            Forms![Bid - Master Form]![txtLoginSince] = Me.txtLoginSince
            
        Else    'access limited to own records
            DoCmd.OpenForm "Bid - Master Form", , , "[Estimator]='" & UserName & "'"
            Forms![Bid - Master Form]![RecordAccessRights] = "Restricted"
            Forms![Bid - Master Form]![txtUserName] = UserName
            Forms![Bid - Master Form]![txtLoginSince] = Me.txtLoginSince
            
        End If
    
    Else                            'Access rights to estimating denied
        MsgBox "You are not authorized to enter Estimating.  Please contact your supervisor for help.", vbCritical, "Access Denied"
    End If
    [COLOR=darkred]DoCmd.Hourglass (False)
[/COLOR]ExitSub:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & "  " & Err.Description & " at 'hypEstimating_Click()'"
    DoCmd.Hourglass (False)
    Resume ExitSub
End Sub

 

[ghudson]

Access has a problem with updating displayed items when it is busy. Try adding a pause command right below the hourglass command. I use the below pause function to display status updates in a label on a form during lengthy processes. The sleep command does not work in this situation but the below pause function might be what you need.

Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Err_Pause

    Dim PauseTime As Variant, start As Variant

    PauseTime = NumberOfSeconds
    start = Timer
    Do While Timer < start + PauseTime
    DoEvents
    Loop

Exit_Pause:
    Exit Function

Err_Pause:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "Pause()"
    Resume Exit_Pause

End Function

This is how you call it for a one tenth of a second pause...

Pause (0.1)