What event is my report doing?? (1 Viewer)

[April15Hater]

I have a report that I'm running in report view. When I open it, it will open the detail sans one column (uses a VB UDF). Then it wipes that. Then loads the detail followed by the UDF column it initially left out. Then it moves to the footer......and it seems like it is going through this gyration 3-4 times before finally fully loading. I'd like to drop an hourglass and echo off while this is going on, but I can't figure out for the life of me what event is taking place. I tried form load, various onpaints, open, and I just can't seem to get this one.

Any ideas guys?

Thanks,

Joe

 

[mdlueck]

I would suggest setting a break point on the troublesome report's Report_Open event, and use F8 to step through the code in search of the source of the delays you speak of.

 

[April15Hater]

That's what's throwing me off. The Open and Load events are completed when this is happening.

 

[mdlueck]

And you are still doing F8 stepped execution, Open ends, leads to Load, Load ends (F8), then the long delay with no indication in the VBA editor screen what is going on?

Order of events for database objects (A2007)
http://office.microsoft.com/en-us/access-help/order-of-events-for-database-objects-HA010238988.aspx

(Although, in A2007 Load is an event of Reports (as well as Forms) which fires after Open. Must be an omission in the MS docs.)

 

[April15Hater]

UPDATE: It does fire the Detail_Paint event, but how do I know when the report is finished repainting?

---------
That is odd, because they didn't omit it for forms...

But yes, I'm stepping through it f8 by f8 and it's definitely not in load or open.

What is weird is when I go into another application (such Excel or Chrome), and subsequently go back to access, it "reloads" the form for lack of better words. But even with that, the report_load isn't firing nor is the activate or deactivate events.

I thought it might be something with the paint event, but no dice so far. Even so, I'm a little fuzzy on the Paint events and if it is firing on a paint, I don't have the foggiest as to where I would turn the hourglass on and off, or how I would determine the report is done with it's "reloading" deal.

 

[April15Hater]

By the way, here's what's in the code:

'****************************************************************************************
'*
'* Monthly Summary Report
'*
'****************************************************************************************
Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
   lParam As Any) As Long                           'API Declaration for PostMessage
Private Const WM_SYSCOMMAND = &H112                 'SystemCommand Constant
Private Const SC_CLOSE = &HF060&                    'CloseWindow Constant
Private Const mstrcModule = "rptMonthlySummary"     'Constant Module Name for Error Handling

Private Sub Detail_DblClick(Cancel As Integer)
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub

Private Sub Report_Load()
    Dim dtmStartDate As Date
    Dim dtmEndDate As Date
    If Not IsNull(Me.OpenArgs) Then
        If InStr(Me.OpenArgs, "|") > 0 Then
            'Extract OpenArg dates passed in. Don't prompt user to select dates.
            Dim varReportDates As Variant
            varReportDates = Split(Me.OpenArgs, "|")
            Me.txtStartDate = varReportDates(0)
            Me.txtEndDate = varReportDates(1)
            Exit Sub
        Else
            'OpenArgs not valid.  Prompt user to select dates.
            If MsgBox( _
                Prompt:="Invalid dates.  Please select the dates for this report.", _
                Buttons:=vbOKCancel, _
                Title:="Invalid Dates") = vbCancel Then Exit Sub
        End If
    End If

    'Prompt user to set Begin and End Dates.
    Do
        ChooseDate Me.hwnd, "txtStartDate", "Enter Start Date"
        If IsNull(txtStartDate) Then
            PostMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0
            Exit Sub
        End If
        
        ChooseDate Me.hwnd, "txtEndDate", "Enter End Date"
        If IsNull(txtEndDate) Then
            PostMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0
            Exit Sub
        End If
        
        dtmStartDate = Me.txtStartDate
        dtmEndDate = Me.txtEndDate
        
        If dtmStartDate > dtmEndDate Then
            If MsgBox( _
                Prompt:="Start Date must be before End Date.", _
                Buttons:=vbOKCancel, _
                Title:="Date Range") = vbCancel Then
                PostMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0
                Exit Sub
            End If
        End If
    Loop Until dtmStartDate <= dtmEndDate
    SetRecordSource
    
    'Rewrite textboxes
    Me.txtStartDate = dtmStartDate
    Me.txtEndDate = dtmEndDate

Report_Load_Exit:
    Exit Sub

Report_Load_Err:
    Select Case ErrHandler(Err.Number, Err.Description, , "Report_Load", _
        mstrcModule)
        Case Is = vbIgnore: Resume Next
        Case Is = vbAbort: Resume Report_Load_Exit
        Case Is = vbRetry: Resume
    End Select
End Sub

Sub SetRecordSource()
    Dim strSQL As String
    Dim strSELECTField As String
    Dim strSELECTExpr As String
    Dim strSELECTParam As String
    Dim strFROM As String
    Dim strWHERE As String
    Dim strGROUPBY As String
    strSELECTField = _
        "SELECT DISTINCTROW " & _
        "tblMatched_Transactions.ReconDate, "
    strSELECTExpr = _
        "CDbl(Nz(DSum('Abs(ReconAmount )','[tblSamurai_Transactions]'," & _
        "'ReconDate = #' & tblMatched_Transactions.ReconDate & '#'),0)) " & _
        "AS SamuraiAmount, " & _
        "CDbl(Nz(DSum('Abs(ReconAmount )','[tblSTI_Transactions]','ReconDate = #' " & _
        "& tblMatched_Transactions.ReconDate & '#'),0)) " & _
        "AS STIAmount, " & _
        "CDbl(DCount('Nz(ReconAmount, 0)','[tblSamurai_Transactions]','ReconDate = #' " & _
        "& tblMatched_Transactions.ReconDate & '#')) " & _
        "AS SamuraiCount, " & _
        "CDbl(DCount('Nz(ReconAmount, 0)','[tblSTI_Transactions]','ReconDate = #' " & _
        "& tblMatched_Transactions.ReconDate & '#')) AS " & _
        "STICount, " & _
        "CDbl([STIAmount]-[SamuraiAmount]) AS AmountDiff, " & _
        "CDbl([STICount]-[SamuraiCount]) AS CountDiff, "
    strSELECTParam = _
        "('" & txtStartDate & "') AS [Start Date], " & _
        "('" & txtEndDate & "') AS [End Date] "
    strFROM = _
        "FROM tblMatched_Transactions "
    strWHERE = _
        "WHERE " & _
        "tblMatched_Transactions.ReconDate >= #" & Me.txtStartDate & "# AND " & _
        "tblMatched_Transactions.ReconDate <= #" & Me.txtEndDate & "# "
    strGROUPBY = _
        "GROUP BY tblMatched_Transactions.ReconDate;"
    strSQL = strSELECTField & _
        strSELECTExpr & _
        strSELECTParam & _
        strFROM & _
        strWHERE & _
        strGROUPBY
    Me.RecordSource = strSQL
End Sub

Private Sub txtDARAmount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtDARCount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtDetailDate_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtDiffAmount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtDiffCount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtExplanation_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtLedgerAmount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub
Private Sub txtLedgerCount_DblClick(Cancel As Integer)
    'Open Daily Report
    DoCmd.Close acDefault, "rptDailySummary"
    DoCmd.OpenReport "rptDailySummary", acViewReport, , , acWindowNormal, _
        txtDetailDate & "|" & txtDetailDate
End Sub

 

[mdlueck]

What is weird is when I go into another application (such Excel or Chrome), and subsequently go back to access, it "reloads" the form for lack of better words.

That sounds like nonsense I have seen on one form before. I would recommend trying this procedure on a COPY of your database file:

NT Command Script and Documented Steps to Decompile / Compact / Compile an Access DB
http://www.access-programmers.co.uk/forums/showthread.php?t=219948

 

[April15Hater]

Wow! it didn't completely fix the problem, but my db is running MUCH faster! 21 MB to 14 MBs, that's incredible! The Paint is much smoother now though, to the point that I don't even think I will need the hourglass.

Now if you'll excuse me, I have a few more db's I need to run this on!

 

[mdlueck]

I am pleased you have some benefit.

So what do your PostMessage calls do exactly? It appears it tells the window to close. If so, how is that better than:

  'Close window "self"
  DoCmd.Close ObjectType:=acForm, _
              ObjectName:=Me.Name

 

[April15Hater]

Although I try to avoid API calls as much as possible, Access won't allow the close method during the load event, so I have my hands tied.

Edit:
In addition, the choose procedure that I'm running makes a call to a calendar form borrowed from Allen Browne that I tweaked which sets the date to a report by referencing the report's hwnd in case I need to run multiple instances of the report.

I've been meaning to do a further tweaking to the calendar form by way of memory pointers returning the date value to a variable in the function that called it. I just haven't had the time, story of my life!!

Call Calendar form:

Public Sub ChooseDate( _
    ByVal pvlnghWnd As Long, _
    ByVal pvstrControl As String, _
    Optional ByVal pvstrTitle As String)
    'pvlnghWnd                      Windows handle of form/report containing the object
    '                                   to return user-selected date
    'pvstrControl                   Control object on form/report to return user
    '                                   selected date.
    'pvstrTitle                     Title to show in the calendar form
    Dim varReportParams As String   'Variable holding parameter data; passed to
    '                                   frmCalendar through openargs.
    On Error GoTo ChooseDate_Err
    If pvlnghWnd = 0 Or pvstrControl = Empty Then
        'Invalid Parameters
        Err.Raise _
            Number:=1004, _
            Source:="ChooseDate", _
            Description:="The ChooseDate procedure parameters are invalid."
    End If

    'Build OpenArgs variant and open Calendar form.
    varReportParams = pvlnghWnd & "|" & pvstrControl & "|" & pvstrTitle
    DoCmd.OpenForm _
        FormName:="frmCalendar", _
        windowmode:=acDialog, _
        OpenArgs:=varReportParams
        
ChooseDate_Exit:
    Exit Sub

ChooseDate_Err:
    Select Case ErrHandler(Err.Number, Err.Description, , _
        "ChooseDate", mstrcModule)
        Case Is = vbIgnore: Resume Next
        Case Is = vbAbort: Resume ChooseDate_Exit
        Case Is = vbRetry: Resume
    End Select
End Sub

Abridged frmCalendar Events:

Private Sub Form_Open(Cancel As Integer)
Dim objTargetObject As Object           'Walked Report/Form object variable
    On Error GoTo Form_Open_Err
    
    'Get object parameters from OpenArgs
    mvarObjParams = Split(Me.OpenArgs, "|")
    
    'Find report by hWnd and set control object to a variable
    For Each objTargetObject In Access.Reports
        If objTargetObject.hwnd = CLng(mvarObjParams(objecthWnd)) Then
            Set mobjParentObject = objTargetObject
            Set mobjDateObject = objTargetObject.Controls(mvarObjParams(TextboxName))
            Set objTargetObject = Nothing
            Exit For
        End If
    Next objTargetObject
    
    'If report is not found, try forms.
    If Not IsObject(mobjDateObject) Then
        For Each objTargetObject In Access.Forms
            If objTargetObject.hwnd = CLng(mvarObjParams(objecthWnd)) Then
                Set mobjDateObject = objTargetObject.Controls(mvarObjParams(TextboxName))
                Set objTargetObject = Nothing
                Exit For
            End If
        Next objTargetObject
    End If
    
    'Raise an error if neither the Form nor Report exists.
    If Not IsObject(mobjDateObject) Then
        Err.Raise _
            Number:=1004, _
            Source:="mobjDateObject", _
            Description:="The calendar form could not find the " & _
            mvarObjParams(TextboxName) & _
            " control on any open Form or Report specified in the parameters."
    End If
    
    'Initialize to the existing report textbox date, or assign today if no date assigned.
    If IsDate(mobjDateObject) Then
        Me.txtDate = mobjDateObject.Value
    Else
        Me.txtDate = Date
    End If
    
    Me.txtYear = Me.txtDate

    'Lock the Ok button if the text box is locked or disabled.
    With Me.cmdOk
        If .Enabled <> mobjDateObject.Enabled Then
            .Enabled = mobjDateObject.Enabled
        End If
    End With
    
    'Set the title
    If Len(mvarObjParams(CalTitle)) > 1 Then
        Me.Caption = mvarObjParams(CalTitle)
    End If
    
    'Set up the calendar for date in txtDate.
    Call ShowCal
    
Form_Open_Exit:
    Exit Sub

Form_Open_Err:
    
    Select Case ErrHandler(Err.Number, Err.Description, , _
        "Form_Open", mstrcModule)
        Case Is = vbIgnore: Resume Next
        Case Is = vbAbort: Resume Form_Open_Exit
        Case Is = vbRetry: Resume
    End Select
End Sub

Private Sub cmdOk_Click()
    'Purpose:                           'Transfer the result back to the control passed
    '                                       in OpenArgs, and close calendar form.
    DoCmd.Hourglass True
    If Me.cmdOk.Enabled Then
        If mobjDateObject = Me.txtDate Then
            'do nothing
        Else
            mobjDateObject = Me.txtDate
        End If
    End If
    DoCmd.Hourglass False
    DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

 

[mdlueck]

Access won't allow the close method during the load event, so I have my hands tied.

hhhmmm... could you not pre-validate and avoid opening the form which will not be allowed to finish?

Interesting trick you found none the less!

 

[April15Hater]

No unfortunately, because frmCalendar writes to a report's textbox control which can't be modified in the open event since the textbox isn't opened yet. Bummer, huh? That's why I want to go with the variable pointer method on frmCalendar, so that I can add it.... wherever I want!!! <evil laugh> Although that requires API calls too if I want to avoid the evil, undocumented, supposedly going away in 2013 VarPtr function.

They just need to make an event in between Open and Load that will let us modify controls in Open, yet Cancel on Load. Us Office folk get no MS love. :banghead:

 

[mdlueck]

Although I try to avoid API calls as much as possible, Access won't allow the close method during the load event, so I have my hands tied.

Aaahhh, tap tap... is this thing on...

[B]Private Sub Form_Load()[/B]
  On Error GoTo Err_Form_Load

 'Store the logged in UserID into the DB obj
  ObjAuthTbl.userid = getusername_GetUserName()

  'Query the auth table based on the userid
  If Not ObjAuthTbl.LocateUserByUserID Then
    'Clear the mouse hourglass pointer
    Call uiutils_SetMouseDefault

    'Open the errorauth dialog and exit
    strDocName = "errorauth"
    flgInitArchitecture = True
    DoCmd.OpenForm FormName:=strDocName
[B]    'Close window "self"
    Call uiutils_CloseFormMe(Me)[/B]
    GoTo Exit_Form_Load
  End If

Exit_Form_Load:
  Exit Sub

Err_Form_Load:
  Call errorhandler_MsgBox("Form: " & Me.Module.Name & ", Subroutine: Form_Load()")
  
  'Close all of Access... bye bye now bye bye!!
  DoCmd.Quit
  
  Resume Exit_Form_Load

End Sub

The call to shared code...

Sub uiutils_CloseFormMe(ByRef MePointer As Access.Form)
  On Error GoTo Err_uiutils_CloseFormMe

  'Close window "self"
  DoCmd.Close ObjectType:=acForm, _
              ObjectName:=MePointer.Name

Exit_uiutils_CloseFormMe:
  Exit Sub

Err_uiutils_CloseFormMe:
  Call errorhandler_MsgBox("Module: modshared_uiutils, Function: uiutils_CloseFormMe()")
  Resume Exit_uiutils_CloseFormMe

End Sub

Within the Form_Load event, I am able to successfully close the form Me, aka same form that the Load event is running on. Well tested with A2007. (shrug)

Now, I have not tested with the Open event, only with Load.

 

[April15Hater]

You had me thinking I was dreaming error messages for a minute there...

I substituted the code, and it worked fine. But then it finally dawned on me: It was how I was opening the report. Not sure how this will work with a form, but try replacing:

DoCmd.OpenForm FormName:=strDocName

with

DoCmd.OpenForm FormName:=strDocName, View:=acPreview

If I call my report with:

DoCmd.OpenReport "rptMonthlySummary", acViewPreview

instead of

DoCmd.OpenReport "rptMonthlySummary", acViewReport

I get a Runtime 2585: This action can't be carried out while processing a form or report event.

Now, I have not tested with the Open event, only with Load.

No need on the Open event though. It's just as easy to set Cancel=True and call it a day.

 

[mdlueck]

Very odd. Thank you for pointing this condition out.