Access 2007 Iintermittent print problem.

J

jjjax

Since upgrading our users from Access 2000 runtime on Windows 2000 to Access
2007 runtime on XP Pro, we seem to have some problems when they run some code
that loops through and prints multiple reports. It hangs on windows now
printing page x of y. No error but need to kill acces task to get out.
Printers appear to be fine but seems to randomly happen so have not been able
to figure out the exact conditons to cause this but am trying to narrow. One
of our Access developers here mentioned he has seen this before but can't
remember how he handle it so hoping someone else might have seen this? Below
is the code for an on click event and it seems to happen in the invoice print
loop. I just put some step logs in to try to narrow down exactly where it
might be happening to see if any logic to it. Thanks, Joe

Private Sub cmdPrint1_Click()
Dim Err As ADODB.Error
Dim stDocName As String
On Error GoTo ErrorHandler

Dim Conn As ADODB.Connection
Set Conn = CurrentProject.Connection
Conn.CommandTimeout = 120

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '1 - Start', @Batch =" &
Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

If IsNull(Forms!frmMainMenu!cboMultiPartPrinters) Then
MsgBox ("The Laser and Multi Part Printers must both be selected!")
Exit Sub
End If

If IsNull(Forms!frmMainMenu!cboLaserPrinters) Then
MsgBox ("The Laser and Multi Part Printers must both be selected!")
Exit Sub
End If

Forms!frmMainMenu!txtShipBatch = Forms!frmReadyToShip!tbl_BatchNumber

''''''''''''''''''''''''''''''''''''''''''
' After you make a selection, go write
' the string out to WIN.INI.

Dim dr As aht_tagDeviceRec
Dim intRetval As Integer
Dim ctl As Control

'''''''''''''''''
' Get Original Default Printer and save to drDefaultPrinterBuffer
Dim drDefaultPrinterBuffer As String
drDefaultPrinterBuffer = ahtGetINIString("Windows", "Device")
'''''''''''''''''

Set ctl = Forms!frmMainMenu!cboMultiPartPrinters
With dr
.drDeviceName = ctl.Column(1)
.drDriverName = ctl.Column(2)
'.drPort = ctl.Column(3) commented out as of 05/10/06
End With
Application.Printer = Nothing
intRetval = ahtSetDefaultPrinter(dr)
stDocName = "RptDriversReturnsSheet"
DoCmd.OpenReport stDocName, acViewNormal, "", ""

Set ctl = Forms!frmMainMenu!cboLaserPrinters
With dr
.drDeviceName = ctl.Column(1)
.drDriverName = ctl.Column(2)
'.drPort = ctl.Column(3) commented out as of 05/10/06
End With
Application.Printer = Nothing
intRetval = ahtSetDefaultPrinter(dr)


DoCmd.SetWarnings False
Conn.Execute "Execute spBatchShippedUpdate @Batch =" & Me.txtBatch

Dim spcmd As Command
Dim sprst As Recordset
Dim spConn As Connection

Set spConn = CurrentProject.Connection
spConn.CommandTimeout = 120

DoCmd.SetWarnings False

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '2 - rptTallySheetStart',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

stDocName = "RptTallySheet"
DoCmd.OpenReport stDocName, acViewNormal, "", ""

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '3 -
rptCustomerShippingList', @Batch =" & Forms!frmReadyToShip!tbl_BatchNumber &
", @Customer=''"

stDocName = "RptCustomerShippingList"
DoCmd.OpenReport stDocName, acViewNormal, "", ""

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '4 - rptLoadingSheet',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

If Forms!frmMainMenu!txtLoadOption = 1 Or
Forms!frmMainMenu!txtLoadOption = 4 Then
stDocName = "RptLoadingSheet"
DoCmd.OpenReport stDocName, acViewNormal, "", ""
End If
Conn.Execute "Execute jjUpdateInvoiceLog @Step = '5 - rptChasePicks', @Batch
=" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"
stDocName = "RptChasePicks"
DoCmd.OpenReport stDocName, acViewNormal, "", ""

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '6 -
spTrafficPickUpsOnBatch', @Batch =" & Forms!frmReadyToShip!tbl_BatchNumber &
", @Customer=''"

Set spcmd = New Command
Set spcmd.ActiveConnection = spConn
spcmd.CommandText = "spTrafficPickUpsOnBatch"

Set sprst = spcmd.Execute(, Array(Me.txtBatch), adCmdStoredProc)

Do While Not sprst.EOF

Forms!frmMainMenu!txtPO = sprst!tblpoh_ID

DoCmd.SetWarnings False

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '7 - rptPickupOrders',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

stDocName = "RptPickUpOrders"
DoCmd.OpenReport stDocName, acViewNormal, "", ""

sprst.MoveNext

Loop

sprst.Close ' 10/30/07
spConn.Close ' 10/30/07

Set spConn = CurrentProject.Connection ' 10/30/07
spConn.CommandTimeout = 120 ' 10/30/07

'Print all the invoices for this batch here

Set spcmd = New Command

Set spcmd.ActiveConnection = spConn
spcmd.CommandText = "spInvoiceInfoByBatchInvoicesShipping"

Set sprst = spcmd.Execute(, Array(Me.txtBatch), adCmdStoredProc)

'***Seems to be happening intermittently during this Do While

Do While Not sprst.EOF

Dim objFileSystem As Object
Dim stFileName As String
Dim InputAnswer As String
Dim FTPAddress As String
Dim FTPAddressLit As String

Forms!frmMainMenu!txtFacility = sprst!tblohb_Facility
Forms!frmMainMenu!txtCustomer = sprst!PC_CUST_NUM
Forms!frmMainMenu!txtCollectType = sprst!PC_CUST_COLLECT_TYPE
Forms!frmMainMenu!txtInvoice = sprst!tblohb_ID

DoCmd.SetWarnings False

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '8 - rptInvoicePrint',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer='" &
sprst!PC_CUST_NUM & "'"

If sprst!PC_CUST_TYPE_BILL = 3 Then
Conn.Execute "execute spRptInvoicePrintEC @InvoiceID =" &
sprst!tblohb_ID & ",@Indicate = " & 1, -1
stDocName = "rptInvoicePrintEC"
Else
Conn.Execute "execute spRptInvoicePrint @InvoiceID =" &
sprst!tblohb_ID & ",@Indicate = " & 1, -1
stDocName = "rptInvoicePrint"
End If

DoCmd.OpenReport stDocName, acViewNormal, "", ""


'Type 2 is for ASN/RCN's which go to the FTP site.
If sprst!PC_CUST_INVOICE_SEND_TYPE = 2 Then

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '9 - IF ASN/RCN', @Batch ="
& Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer='" & sprst!PC_CUST_NUM
& "'"

FTPAddress = "\\APP1\INETPUB\FTPROOT\CUSTOMERS\" &
sprst!PC_CUST_FTP_CUSTOMER_FOLDER & "\" & sprst!tblohb_ID & "ASN.txt"
FTPAddressLit = "'\\APP1\INETPUB\FTPROOT\CUSTOMERS\" &
sprst!PC_CUST_FTP_CUSTOMER_FOLDER & "\" & sprst!tblohb_ID & "ASN.txt'"
Conn.Execute "execute spInvoiceASN @InvoiceID = " & sprst!tblohb_ID
DoCmd.TransferText acExportDelim, , "dbo.tblInvoiceASN", FTPAddress
Kill ("\\APP1\INETPUB\FTPROOT\CUSTOMERS\" &
sprst!PC_CUST_FTP_CUSTOMER_FOLDER & "\" & "schema.ini")
Conn.Execute "execute spAddEntryToDeleteFTPFilesTable
@FileLocationAndName =" & FTPAddressLit
End If

'Type 1 is for Email Snapshots.
If sprst!PC_CUST_INVOICE_SEND_TYPE = 1 Then

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '10 - IF Email Snapshot',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer='" &
sprst!PC_CUST_NUM & "'"


Tryagain:
InputAnswer = MsgBox("An Email Snapshot is to follow. Click YES To
Continue.", 260)

If InputAnswer <> vbYes Then
GoTo Tryagain
End If

'Create snapshot
'stFileName = "U:\InvoiceEmails\Invoice_" & sprst!tblohb_ID & ".snp"
01/08/07
stFileName = "\\app1\updates\InvoiceEmails\Invoice_" & sprst!tblohb_ID &
".snp"
DoCmd.OutputTo acOutputReport, "rptInvoicePrintSnapshot", acFormatSNP,
stFileName, False

'Email snapshot
Conn.Execute "execute spInvoiceEmail @Invoice=" & sprst!tblohb_ID & _
",@Customer='" & sprst!PC_CUST_NUM & _
"',@Facility='" & sprst!tblohb_Facility & "'"

'Delete the snapshot file when done.
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
objFileSystem.DeleteFile (stFileName)
Set objFileSystem = Nothing

End If

sprst.MoveNext

Loop

sprst.Close
spConn.Close
Conn.Close

'Moved form close to below printer restore - 7/25/09 JJ
'DoCmd.Close acForm, "frmDriver"

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '11 - Restore Printer',
@Batch =" & Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

''''''''''''''
' Restore Origonal Default Printer from drDefaultPrinterBuffer
Application.Printer = Nothing
intRetval = True ' make sure this is true to
execute next line
intRetval = (aht_apiWriteProfileString("Windows", _
"Device", drDefaultPrinterBuffer) <> 0)
''''''''''''''

If Forms!frmMainMenu!frm1PartAuto = 1 Then 'Auto On Change Printers
Forms!frmMainMenu!cboLaserPrinters.Enabled = True
Forms!frmMainMenu!cboLaserPrinters.Locked = False
Forms!frmMainMenu!cboLaserPrinters.SetFocus
If Forms!frmMainMenu!cboLaserPrinters.ListCount - 1 =
Forms!frmMainMenu!cboLaserPrinters.ListIndex Then
Forms!frmMainMenu!cboLaserPrinters.ListIndex = 0
Else
Forms!frmMainMenu!cboLaserPrinters.ListIndex =
Forms!frmMainMenu!cboLaserPrinters.ListIndex + 1
End If
Forms!frmMainMenu!cmdInvoicePrintedByBatch.SetFocus
Forms!frmMainMenu!cboLaserPrinters.Enabled = False
Forms!frmMainMenu!cboLaserPrinters.Locked = True
End If

If Forms!frmMainMenu!frmMultiAuto = 1 Then 'Auto On Change Printers
Forms!frmMainMenu!cboMultiPartPrinters.Enabled = True
Forms!frmMainMenu!cboMultiPartPrinters.Locked = False
Forms!frmMainMenu!cboMultiPartPrinters.SetFocus
If Forms!frmMainMenu!cboMultiPartPrinters.ListCount - 1 =
Forms!frmMainMenu!cboMultiPartPrinters.ListIndex Then
Forms!frmMainMenu!cboMultiPartPrinters.ListIndex = 0
Else
Forms!frmMainMenu!cboMultiPartPrinters.ListIndex =
Forms!frmMainMenu!cboMultiPartPrinters.ListIndex + 1
End If
Forms!frmMainMenu!cmdInvoicePrintedByBatch.SetFocus
Forms!frmMainMenu!cboMultiPartPrinters.Enabled = False
Forms!frmMainMenu!cboMultiPartPrinters.Locked = True
End If

Conn.Execute "Execute jjUpdateInvoiceLog @Step = '12 - End', @Batch =" &
Forms!frmReadyToShip!tbl_BatchNumber & ", @Customer=''"

DoCmd.Close acForm, "frmDriver"
Exit Sub

ErrorHandler:
For Each Err In Conn.Errors
MsgBox Err.Description
Next
Exit Sub
End Sub
 
J

jjjax

Update: Looks like it was one subreport on one report that hits a certain
condition once in awhile which was the cause. It's weird because if run the
report by itself, it prints even though one of the total calulations has an
issue with a !Num yet it run that via vba, it hangs. Maybe because we have
on error checking in vb code so maybe that was hanging it. This report was a
problem since going to access 2007 from 2000 because it seems like 2007 is
more strict with calculated and total fields when based on other fields on
reports and forms that may have nulls or zeroes.

Anyway, thanks.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

looking for a way around a write conflict... 2
VBA Coding 3
VBA works in orignal but fails in copy of database 1
Print and Collate 2 seperate reports 0
Extract name, address and ph# 8
How to print a report with multiple tab controls 1
Second Report not printing - whats wrong with the VBA? 1
Help prevent report from running 1

Top