D
DS
Is There any way to speed this code up. It takes about 4 Seconds for any of
the forms to pop up.
Thanks
DS
Dim rtn As Long
Dim Driver As String
Dim I As Integer
Dim X As Printer
''SECURITY
Me.TxtSecure = Nz(DLookup("[JobNameSecurityID]", "tblJobNames",
"JobNameID = " & Me.TxtJobID & ""), 0)
Me.TxtPriv = Nz(DLookup("[SDPrivID]", "tblSecurityDetails", "SecurityID
= " & Me.TxtSecure & " And SDPrivID = 39"), 0)
'SENDING
Me.TxtCount = Nz(DCount("CDSent", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)
'PRINTERS
'CHECKS PRINTER AVAILABILITY
Me.TxtNumber = Nz(DMax("PDPrinterID", "tblPrintDetails", "PDCheckID = "
& Me.CheckID), 0)
If Me.TxtNumber >= 1 Then
On Error GoTo ErrorHandler
Do
Me.TxtEmpty = Nz(DCount("PDPrinterID", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber & "AND PDCheckID = " & Me.CheckID), 0)
If IsNull(Me.TxtEmpty) Or _
Me.TxtEmpty = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
ElseIf Me.TxtEmpty >= 1 Then
Me.TxtName = Nz(DLookup("PrinterName", "tblPrinters", "PrinterID
= " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
m_PrtN = Me.TxtName
If Len(Me.TxtName) = 0 Then
Exit Sub
End If
rtn = GetPrnDriverName(m_PrtN, Driver)
If rtn <> 0 Then
Driver = ""
End If
m_DrvN = Driver
m_hApi = BiOpenMonPrinter(TYPE_PRINTER, m_PrtN)
If m_hApi < 0 Then
Me.TxtError = 0
DoCmd.OpenForm "frmNoPrinter"
Forms!frmNoPrinter!Label2.Caption = Me.TxtName & " " &
"Offline"
Exit Sub
ElseIf m_hApi > 0 Then
End If
BiCloseMonPrinter (m_hApi)
ElseIf m_hApi = 0 Then
End If
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
Loop Until Me.TxtNumber = 0
Me.TxtError = 1
If Me.TxtPriv > 0 And _
Me.TxtCount > 0 And _
Me.TxtError > 0 Then
'SEND AND LEAVE
Dim PO As Integer
Dim SENDSQL As String
Dim DEADSQL As String
DoCmd.OpenForm "frmSending"
Me.TxtNumber = Nz(DMax("PDPrinterID", "tblPrintDetails", "PDCheckID
= " & Me.CheckID), 0)
On Error GoTo ErrorHandler
Do
Me.TxtEmpty = Nz(DCount("PDPrinterID", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber & "AND PDCheckID = " & Me.CheckID), 0)
If IsNull(Me.TxtEmpty) Or _
Me.TxtEmpty = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
ElseIf Me.TxtEmpty >= 1 Then
Me.TxtCon = Nz(DLookup("PDCon", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber), 0)
If Me.TxtCon = -1 Then
Me.TxtItemID = Nz(DLookup("PDItemID",
"tblPrintDetails", "PDPrinterID = " & Me.TxtNumber), 0)
Me.TxtGo = Nz(DCount("PDItemID", "tblPrintDetails",
"PDItemID <> " & Me.TxtItemID & " And PDPrinterID = " & Me.TxtNumber & "And
PDCheckID = " & Me.CheckID), 0)
If Me.TxtGo >= 1 Then
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID
= " & Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
ElseIf Me.TxtGo = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID
= " & Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
End If
ElseIf Me.TxtCon = 0 Then
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID = "
& Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
End If
End If
Loop Until Me.TxtNumber = 0
'SEND ITEMS
DoCmd.SetWarnings False
SENDSQL = "UPDATE tblCheckDetails SET [CDSent] = True " & _
"WHERE tblCheckDetails.[CDCheckID] =
Forms!frmOrderScreen![CheckID]; "
DoCmd.RunSQL (SENDSQL)
DEADSQL = "UPDATE tblPrintDetails SET [PDDead] = True " & _
"WHERE tblPrintDetails.[PDCheckID] =
Forms!frmOrderScreen![CheckID]; "
DoCmd.RunSQL (DEADSQL)
DoCmd.SetWarnings True
Me.ListPrep.Requery
End
ErrorHandler:
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "INVALID PRINTER"
ElseIf Me.TxtPriv > 0 And _
Me.TxtCount = 0 And _
Me.TxtError >= 0 Then
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "NOTHING TO SEND"
Else:
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "SENDING DENIED"
End If
End If
the forms to pop up.
Thanks
DS
Dim rtn As Long
Dim Driver As String
Dim I As Integer
Dim X As Printer
''SECURITY
Me.TxtSecure = Nz(DLookup("[JobNameSecurityID]", "tblJobNames",
"JobNameID = " & Me.TxtJobID & ""), 0)
Me.TxtPriv = Nz(DLookup("[SDPrivID]", "tblSecurityDetails", "SecurityID
= " & Me.TxtSecure & " And SDPrivID = 39"), 0)
'SENDING
Me.TxtCount = Nz(DCount("CDSent", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)
'PRINTERS
'CHECKS PRINTER AVAILABILITY
Me.TxtNumber = Nz(DMax("PDPrinterID", "tblPrintDetails", "PDCheckID = "
& Me.CheckID), 0)
If Me.TxtNumber >= 1 Then
On Error GoTo ErrorHandler
Do
Me.TxtEmpty = Nz(DCount("PDPrinterID", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber & "AND PDCheckID = " & Me.CheckID), 0)
If IsNull(Me.TxtEmpty) Or _
Me.TxtEmpty = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
ElseIf Me.TxtEmpty >= 1 Then
Me.TxtName = Nz(DLookup("PrinterName", "tblPrinters", "PrinterID
= " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
m_PrtN = Me.TxtName
If Len(Me.TxtName) = 0 Then
Exit Sub
End If
rtn = GetPrnDriverName(m_PrtN, Driver)
If rtn <> 0 Then
Driver = ""
End If
m_DrvN = Driver
m_hApi = BiOpenMonPrinter(TYPE_PRINTER, m_PrtN)
If m_hApi < 0 Then
Me.TxtError = 0
DoCmd.OpenForm "frmNoPrinter"
Forms!frmNoPrinter!Label2.Caption = Me.TxtName & " " &
"Offline"
Exit Sub
ElseIf m_hApi > 0 Then
End If
BiCloseMonPrinter (m_hApi)
ElseIf m_hApi = 0 Then
End If
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
Loop Until Me.TxtNumber = 0
Me.TxtError = 1
If Me.TxtPriv > 0 And _
Me.TxtCount > 0 And _
Me.TxtError > 0 Then
'SEND AND LEAVE
Dim PO As Integer
Dim SENDSQL As String
Dim DEADSQL As String
DoCmd.OpenForm "frmSending"
Me.TxtNumber = Nz(DMax("PDPrinterID", "tblPrintDetails", "PDCheckID
= " & Me.CheckID), 0)
On Error GoTo ErrorHandler
Do
Me.TxtEmpty = Nz(DCount("PDPrinterID", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber & "AND PDCheckID = " & Me.CheckID), 0)
If IsNull(Me.TxtEmpty) Or _
Me.TxtEmpty = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
ElseIf Me.TxtEmpty >= 1 Then
Me.TxtCon = Nz(DLookup("PDCon", "tblPrintDetails",
"PDPrinterID = " & Me.TxtNumber), 0)
If Me.TxtCon = -1 Then
Me.TxtItemID = Nz(DLookup("PDItemID",
"tblPrintDetails", "PDPrinterID = " & Me.TxtNumber), 0)
Me.TxtGo = Nz(DCount("PDItemID", "tblPrintDetails",
"PDItemID <> " & Me.TxtItemID & " And PDPrinterID = " & Me.TxtNumber & "And
PDCheckID = " & Me.CheckID), 0)
If Me.TxtGo >= 1 Then
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID
= " & Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
ElseIf Me.TxtGo = 0 Then
Me.TxtNumber = Me.TxtNumber - 1
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID
= " & Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
End If
ElseIf Me.TxtCon = 0 Then
Me.TxtName = Nz(DLookup("PrinterName",
"tblPrinters", "PrinterID = " & Me.TxtNumber), "")
If Not Me.TxtName = "No Print" Then
Set Application.Printer =
Application.Printers(Me.TxtName.Value)
DoCmd.OpenReport "rptPrepOrder", , , "PDCheckID = "
& Me.CheckID & " And PDPrinterID = " & Me.TxtNumber & ""
Me.TxtNumber = Me.TxtNumber - 1
Set Application.Printer = Nothing
Else
End If
End If
End If
Loop Until Me.TxtNumber = 0
'SEND ITEMS
DoCmd.SetWarnings False
SENDSQL = "UPDATE tblCheckDetails SET [CDSent] = True " & _
"WHERE tblCheckDetails.[CDCheckID] =
Forms!frmOrderScreen![CheckID]; "
DoCmd.RunSQL (SENDSQL)
DEADSQL = "UPDATE tblPrintDetails SET [PDDead] = True " & _
"WHERE tblPrintDetails.[PDCheckID] =
Forms!frmOrderScreen![CheckID]; "
DoCmd.RunSQL (DEADSQL)
DoCmd.SetWarnings True
Me.ListPrep.Requery
End
ErrorHandler:
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "INVALID PRINTER"
ElseIf Me.TxtPriv > 0 And _
Me.TxtCount = 0 And _
Me.TxtError >= 0 Then
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "NOTHING TO SEND"
Else:
DoCmd.OpenForm "frmMsgWarning"
Forms!frmMsgWarning!TxtMsg = "SENDING DENIED"
End If
End If