[RESOLVED] Application Error when subreport existed

[ahpaul]

Declare

Public crApp As New CRAXDRT.Application
Public crRep As New CRAXDRT.Report
 
Private rptRc As New Recordset
Private rptSubRc As New Recordset
Private rptSubRc2 As New Recordset

Module

Public Sub DriverAdvanceHistory(ByVal d As Date)
    Busy
        
    rptRc.Open "SELECT CD.CoachDriverID, CD.Name, CD.Contact, " _
            & "CA.CoachDriverAdvanceID, CA.AdvanceDate, CA.Amount AS 'AdvanceAmount', CA.Balance, " _
            & "CC.ClearDate, CC.Amount AS 'ClearAmount', A.Name AS 'Account', (CASE CA.AdvanceBy WHEN 0 THEN 'Bank' WHEN 1 THEN 'Cash' END) AS 'By' " _
            & "FROM CoachDriver CD, CoachDriverAdvance CA LEFT JOIN CoachDriverClear CC ON CA.CoachDriverAdvanceID = CC.CoachDriverAdvanceID, Account A " _
            & "WHERE CD.CoachDriverID = CA.CoachDriverID " _
            & "AND AdvanceDate BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _
            & "AND CA.AccountID = A.AccountID " _
            & "ORDER BY CD.Name, CA.AdvanceDate, CC.ClearDate", cn, adOpenForwardOnly, adLockReadOnly
            
    If rptRc.RecordCount = 0 Then
        rptRc.Close
        MsgBox "There is no data in the report.", vbInformation + vbOKOnly
        Idle
        Exit Sub
    End If
        
    Set crRep = crApp.OpenReport(App.Path & "\Reports\Advance\DriverAdvanceHistory.rpt")
    
    rptSubRc.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'BalanceBF' " _
            & "FROM CoachDriverAdvance " _
            & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _
            & "AND AdvanceDate NOT BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _
            & " GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly
            
    rptSubRc2.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'Balance' " _
            & "FROM CoachDriverAdvance " _
            & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _
            & "GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly
    
    With crRep
        .ReadRecords
        .DiscardSavedData
        .PaperSize = crPaperA4
        .PaperOrientation = crPortrait
        
        .OpenSubreport("DriverAdvanceBalanceBF").Database.SetDataSource rptSubRc
        .OpenSubreport("DriverAdvanceBalance").Database.SetDataSource rptSubRc2
        
        .Database.SetDataSource rptRc
    End With
    Printer.PaperSize = vbPRPSA4
    Printer.Orientation = vbPRORPortrait
    
    frmPrint.txtDescription = "Driver Advance History" & vbCrLf _
                            & "From " & Format(d, "dd MMMM yyyy")
    frmPrint.Show vbModal
        
    
    rptRc.Close
    rptSubRc.Close
    rptSubRc2.Close
    
    Set crRep = Nothing
End Sub

frmPrint

Option Explicit
 
Private ptr As Printer
 
Private Sub SetPrinter()
    Dim p As Printer
    
    Set ptr = Printer   ' Made default
    
    For Each p In Printers
        If lvwPrinter.SelectedItem = p.DeviceName Then
            Set ptr = p
            Exit For
        End If
    Next
    
    Set p = Nothing
    
    crRep.SelectPrinter ptr.DriverName, ptr.DeviceName, ptr.Port
    crRep.PaperOrientation = Printer.Orientation
End Sub
 
Private Sub RefreshPrinter()
    With lvwPrinter.ListItems
        For Each ptr In Printers
            .Add , , ptr.DeviceName, 1
        Next
        
        Dim i As Integer
    
        For i = 1 To .Count
            If .Item(i) = Printer.DeviceName Then
                .Item(i).Selected = True
                Exit For
            End If
        Next
    End With
End Sub
 
Private Sub cmdCancel_Click()
    Unload Me
End Sub
 
Private Sub cmdPreview_Click()
    Busy
    SetPrinter
    Load frmPreview
    DoEvents
    frmPreview.Show vbModal
    DoEvents
    Idle
End Sub
 
Private Sub cmdPrint_Click()
    Busy
    SetPrinter
    DoEvents
    crRep.PrintOut False
    DoEvents
    Idle
End Sub
 
Private Sub Form_Activate()
    Idle
End Sub
 
Private Sub Form_Load()
    RefreshPrinter
    Idle
End Sub

frmPrint

Option Explicit
 
Private Sub Form_Load()
    Busy
    On Error Resume Next
    crvPreview.ReportSource = crRep
    DoEvents
    crvPreview.ViewReport
    crvPreview.Refresh
    Idle
End Sub
 
Private Sub Form_Resize()
    crvPreview.Top = 0
    crvPreview.Left = 0
    crvPreview.Height = ScaleHeight
    crvPreview.Width = ScaleWidth
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Set frmPreview = Nothing
End Sub

Hi I'm having appcation error, the memory xxxx to xxx canot be "read" or "write" error while using these kind of module.

The first print is Ok, but following report will be cause the error.

However I've tried many ways:
1) Put declare of all declaration inside the sub
2) Directly output to frmpreview without going into frmPrint
3) Print directly without going into frmPrint
4) set crrep = nothing after use (cause hangs directly)
5) etc

The cr I'm using it's 9.0 sp6, vb6.0 sp6, ado 2.8. I wonder any solution for my problem? Quite urgent for this, cause the program is done and I only have this major printing problem.

Thank you very much~

[ahpaul]

Addition: There would be no problem if the report don't have any subreport.