Code:
Public Function LabelPrint() As Variant
Dim strSQL As String
Dim intBoxCount As String
Dim intLabelCheck As Integer
Dim intResponse As Integer
Dim strDefaultPrinter As String
On Error GoTo ErrorHandler
If IsNull(txtBox) Then
MsgBox "Need a box number to print.", , "Box Number"
Exit Function
End If
DoCmd.RunCommand acCmdSaveRecord
'Verify any product is assigned to box number
intBoxCount = Nz(DCount("[BoxNumber]", "[tblOrderDetail]", "[BoxNumber] = " & txtBox & " and [OrderID] = " & txtOrderID & ""), 0)
If intBoxCount > 0 And txtBox > 0 Then
'Check if label has been printed before and check if user still wants to print
intLabelCheck = Nz(DCount("[ShipmentLabelPrint]", "[tblOrderDetail]", "[BoxNumber] = " & txtBox & " and [OrderID] = " & txtOrderID & " and [ShipmentLabelPrint] = -1"), 0)
If intLabelCheck > 0 Then
intResponse = MsgBox("Do you want to reprint the label?", vbYesNo + vbQuestion, "Reprint Label?")
If intResponse = vbNo Then
Exit Function
End If
End If
'Mark line item as label printed
strSQL = "UPDATE tblOrderDetail SET tblOrderDetail.ShipmentLabelPrint = True " & _
vbCrLf & "WHERE (((tblOrderDetail.OrderID)=" & txtOrderID & ") AND ((tblOrderDetail.BoxNumber)=" & txtBox & "));"
CurrentDb.Execute strSQL, dbFailOnError
'Print in subcategory then product order
If txtLabelOrder = 1 Then
DoCmd.OpenReport "rptShipmentLabelPackProd", acViewPreview
DoCmd.SelectObject acReport, "rptShipmentLabelPackProd"
'get current default printer.
strDefaultPrinter = Application.Printer.DeviceName
'switch to printer per user config
Set Application.Printer = Application.Printers(Forms!frmLogin!cboPrinter.Column(1))
DoCmd.PrintOut , , , , 1
'reset back to default
Set Application.Printer = Application.Printers(strDefaultPrinter)
'Update user displayed fields
txtBox = txtBox + 1
'Get the amount of boxes packed so far
txtBoxesPacked = Nz(DCount("[BoxNumber]", "[qryfrmOrderBoxPutAway]"), 0)
'Get the next box that should be packed
txtLastBox = ELookup("BoxNumber", "tblOrderDetail", "BoxNumber Is Not Null and [OrderID] = " & txtOrderID & "", "BoxNumber DESC")
DoCmd.Close acReport, "rptShipmentLabelPackProd"
End If
'Print in code order
If txtLabelOrder = 2 Then
DoCmd.OpenReport "rptShipmentLabelPackCode", acViewPreview
DoCmd.SelectObject acReport, "rptShipmentLabelPackCode"
'get current default printer.
strDefaultPrinter = Application.Printer.DeviceName
'switch to printer per user config
Set Application.Printer = Application.Printers(Forms!frmLogin!cboPrinter.Column(1))
DoCmd.PrintOut , , , , 1
'reset back to default
Set Application.Printer = Application.Printers(strDefaultPrinter)
'Update user displayed fields
txtBox = txtBox + 1
'Get the amount of boxes packed so far
txtBoxesPacked = Nz(DCount("[BoxNumber]", "[qryfrmOrderBoxPutAway]"), 0)
'Get the next box that should be packed
txtLastBox = ELookup("BoxNumber", "tblOrderDetail", "BoxNumber Is Not Null and [OrderID] = " & txtOrderID & "", "BoxNumber DESC")
DoCmd.Close acReport, "rptShipmentLabelPackCode"
End If
'Print in category order
If txtLabelOrder = 3 Then
DoCmd.OpenReport "rptShipmentLabelPackCat", acViewPreview
DoCmd.SelectObject acReport, "rptShipmentLabelPackCat"
'get current default printer.
strDefaultPrinter = Application.Printer.DeviceName
'switch to printer per user config
Set Application.Printer = Application.Printers(Forms!frmLogin!cboPrinter.Column(1))
DoCmd.PrintOut , , , , 1
'reset back to default
Set Application.Printer = Application.Printers(strDefaultPrinter)
'Update user displayed fields
txtBox = txtBox + 1
'Get the amount of boxes packed so far
txtBoxesPacked = Nz(DCount("[BoxNumber]", "[qryfrmOrderBoxPutAway]"), 0)
'Get the next box that should be packed
txtLastBox = ELookup("BoxNumber", "tblOrderDetail", "BoxNumber Is Not Null and [OrderID] = " & txtOrderID & "", "BoxNumber DESC")
DoCmd.Close acReport, "rptShipmentLabelPackCat"
End If
Else
MsgBox "No product in this box number. Unable to print blank label.", , "No Product"
End If
ExitRoutine:
Exit Function
ErrorHandler:
LogError Err, Err.Description, "LabelPrint()", Me
Resume ExitRoutine
End Function