Declare
VB Code:
  1. Public crApp As New CRAXDRT.Application

  2. Public crRep As New CRAXDRT.Report

  3.  
  4. Private rptRc As New Recordset

  5. Private rptSubRc As New Recordset

  6. Private rptSubRc2 As New Recordset

Module
VB Code:
  1. Public Sub DriverAdvanceHistory(ByVal d As Date)

  2.     Busy

  3.         

  4.     rptRc.Open "SELECT CD.CoachDriverID, CD.Name, CD.Contact, " _

  5.             & "CA.CoachDriverAdvanceID, CA.AdvanceDate, CA.Amount AS 'AdvanceAmount', CA.Balance, " _

  6.             & "CC.ClearDate, CC.Amount AS 'ClearAmount', A.Name AS 'Account', (CASE CA.AdvanceBy WHEN 0 THEN 'Bank' WHEN 1 THEN 'Cash' END) AS 'By' " _

  7.             & "FROM CoachDriver CD, CoachDriverAdvance CA LEFT JOIN CoachDriverClear CC ON CA.CoachDriverAdvanceID = CC.CoachDriverAdvanceID, Account A " _

  8.             & "WHERE CD.CoachDriverID = CA.CoachDriverID " _

  9.             & "AND AdvanceDate BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _

  10.             & "AND CA.AccountID = A.AccountID " _

  11.             & "ORDER BY CD.Name, CA.AdvanceDate, CC.ClearDate", cn, adOpenForwardOnly, adLockReadOnly

  12.             

  13.     If rptRc.RecordCount = 0 Then

  14.         rptRc.Close

  15.         MsgBox "There is no data in the report.", vbInformation + vbOKOnly

  16.         Idle

  17.         Exit Sub

  18.     End If

  19.         

  20.     Set crRep = crApp.OpenReport(App.Path & "\Reports\Advance\DriverAdvanceHistory.rpt")

  21.     

  22.     rptSubRc.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'BalanceBF' " _

  23.             & "FROM CoachDriverAdvance " _

  24.             & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _

  25.             & "AND AdvanceDate NOT BETWEEN '" & Format(d, "yyyyMMdd") & "' AND GETDATE() " _

  26.             & " GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly

  27.             

  28.     rptSubRc2.Open "SELECT CoachDriverID, SUM(ISNULL(Balance, 0)) AS 'Balance' " _

  29.             & "FROM CoachDriverAdvance " _

  30.             & "WHERE CoachDriverID IN (SELECT CoachDriverID FROM T_CoachDriver) " _

  31.             & "GROUP BY CoachDriverID", cn, adOpenForwardOnly, adLockReadOnly

  32.     

  33.     With crRep

  34.         .ReadRecords

  35.         .DiscardSavedData

  36.         .PaperSize = crPaperA4

  37.         .PaperOrientation = crPortrait

  38.         

  39.         .OpenSubreport("DriverAdvanceBalanceBF").Database.SetDataSource rptSubRc

  40.         .OpenSubreport("DriverAdvanceBalance").Database.SetDataSource rptSubRc2

  41.         

  42.         .Database.SetDataSource rptRc

  43.     End With

  44.     Printer.PaperSize = vbPRPSA4

  45.     Printer.Orientation = vbPRORPortrait

  46.     

  47.     frmPrint.txtDescription = "Driver Advance History" & vbCrLf _

  48.                             & "From " & Format(d, "dd MMMM yyyy")

  49.     frmPrint.Show vbModal

  50.         

  51.     

  52.     rptRc.Close

  53.     rptSubRc.Close

  54.     rptSubRc2.Close

  55.     

  56.     Set crRep = Nothing

  57. End Sub

frmPrint
VB Code:
  1. Option Explicit

  2.  
  3. Private ptr As Printer

  4.  
  5. Private Sub SetPrinter()

  6.     Dim p As Printer

  7.     

  8.     Set ptr = Printer   ' Made default

  9.     

  10.     For Each p In Printers

  11.         If lvwPrinter.SelectedItem = p.DeviceName Then

  12.             Set ptr = p

  13.             Exit For

  14.         End If

  15.     Next

  16.     

  17.     Set p = Nothing

  18.     

  19.     crRep.SelectPrinter ptr.DriverName, ptr.DeviceName, ptr.Port

  20.     crRep.PaperOrientation = Printer.Orientation

  21. End Sub

  22.  
  23. Private Sub RefreshPrinter()

  24.     With lvwPrinter.ListItems

  25.         For Each ptr In Printers

  26.             .Add , , ptr.DeviceName, 1

  27.         Next

  28.         

  29.         Dim i As Integer

  30.     

  31.         For i = 1 To .Count

  32.             If .Item(i) = Printer.DeviceName Then

  33.                 .Item(i).Selected = True

  34.                 Exit For

  35.             End If

  36.         Next

  37.     End With

  38. End Sub

  39.  
  40. Private Sub cmdCancel_Click()

  41.     Unload Me

  42. End Sub

  43.  
  44. Private Sub cmdPreview_Click()

  45.     Busy

  46.     SetPrinter

  47.     Load frmPreview

  48.     DoEvents

  49.     frmPreview.Show vbModal

  50.     DoEvents

  51.     Idle

  52. End Sub

  53.  
  54. Private Sub cmdPrint_Click()

  55.     Busy

  56.     SetPrinter

  57.     DoEvents

  58.     crRep.PrintOut False

  59.     DoEvents

  60.     Idle

  61. End Sub

  62.  
  63. Private Sub Form_Activate()

  64.     Idle

  65. End Sub

  66.  
  67. Private Sub Form_Load()

  68.     RefreshPrinter

  69.     Idle

  70. End Sub

frmPrint
VB Code:
  1. Option Explicit

  2.  
  3. Private Sub Form_Load()

  4.     Busy

  5.     On Error Resume Next

  6.     crvPreview.ReportSource = crRep

  7.     DoEvents

  8.     crvPreview.ViewReport

  9.     crvPreview.Refresh

  10.     Idle

  11. End Sub

  12.  
  13. Private Sub Form_Resize()

  14.     crvPreview.Top = 0

  15.     crvPreview.Left = 0

  16.     crvPreview.Height = ScaleHeight

  17.     crvPreview.Width = ScaleWidth

  18. End Sub

  19.  
  20. Private Sub Form_Unload(Cancel As Integer)

  21.     Set frmPreview = Nothing

  22. 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~