[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.