Code Is Slow

D

DS

Any way to speed up this code 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
 
G

Guest

The main reason for the code being slow is all the Domain Aggragate functions.
DMax, DCount, DLookup
Domain Aggragate funcitons are slow. The more records in the recordset, the
slower they are.
One thing that will help a little is how you are coding the DCount function.
The result of the DCount, in this case, is not affected by the value in
CDSet except in the criteria.
Me.TxtCount = Nz(DCount("CDSent", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

It will help some if you code it this way
Me.TxtCount = Nz(DCount("*", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

I assume this code is in the Load event of the form. The more a form has to
do before it becomes visible, the slower it appears. You can improve the
user's perception of response if you can find a way to move as much of the
work to other events after the form is loaded as possible.

--
Dave Hargis, Microsoft Access MVP


DS said:
Any way to speed up this code 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
Click to expand...
 
D

DS

Thanks, I tried the "*" in the DCount. It cut it by a second thanks...Can I
use SQL instead? Such as...

SELECT Sum(quantity*Price)
FROM orderdetails;

Just an example! I don't even know if there is one for DCount, DMax,
DLookup

Thanks
DS
Klatuu said:
The main reason for the code being slow is all the Domain Aggragate
functions.
DMax, DCount, DLookup
Domain Aggragate funcitons are slow. The more records in the recordset,
the
slower they are.
One thing that will help a little is how you are coding the DCount
function.
The result of the DCount, in this case, is not affected by the value in
CDSet except in the criteria.
Me.TxtCount = Nz(DCount("CDSent", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

It will help some if you code it this way
Me.TxtCount = Nz(DCount("*", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

I assume this code is in the Load event of the form. The more a form has
to
do before it becomes visible, the slower it appears. You can improve the
user's perception of response if you can find a way to move as much of the
work to other events after the form is loaded as possible.

--
Dave Hargis, Microsoft Access MVP


DS said:
Any way to speed up this code 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
Click to expand...
Click to expand...
 
G

Guest

That would take more coding. You would have to create a recordset, refer to
the field name for the value, then close the recordset.
--
Dave Hargis, Microsoft Access MVP


DS said:
Thanks, I tried the "*" in the DCount. It cut it by a second thanks...Can I
use SQL instead? Such as...

SELECT Sum(quantity*Price)
FROM orderdetails;

Just an example! I don't even know if there is one for DCount, DMax,
DLookup

Thanks
DS
Klatuu said:
The main reason for the code being slow is all the Domain Aggragate
functions.
DMax, DCount, DLookup
Domain Aggragate funcitons are slow. The more records in the recordset,
the
slower they are.
One thing that will help a little is how you are coding the DCount
function.
The result of the DCount, in this case, is not affected by the value in
CDSet except in the criteria.
Me.TxtCount = Nz(DCount("CDSent", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

It will help some if you code it this way
Me.TxtCount = Nz(DCount("*", "tblCheckDetails", "CDCheckID =" &
Me.CheckID & " and CDSent = 0"), 0)

I assume this code is in the Load event of the form. The more a form has
to
do before it becomes visible, the slower it appears. You can improve the
user's perception of response if you can find a way to move as much of the
work to other events after the form is loaded as possible.

--
Dave Hargis, Microsoft Access MVP


DS said:
Any way to speed up this code 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
Click to expand...
Click to expand...
Click to expand...
 

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

Code Is Slow 6
Is This Good? 13
Loop Problem 5
RECORDSET 2
A Lot of Code 10
Complex If Statement 6
Please help changing the way this report is filtered and opened... 2
3rd grade code returns extra zero instead of decimal or hides deci 2

Top