VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX" Begin VB.Form frmOrders Caption = "Orders Information" ClientHeight = 8385 ClientLeft = 60 ClientTop = 345 ClientWidth = 11415 ControlBox = 0 'False KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 8385 ScaleWidth = 11415 StartUpPosition = 2 'CenterScreen Visible = 0 'False Begin VB.TextBox txtOrdCnt Height = 300 Left = 11025 TabIndex = 53 Top = 510 Visible = 0 'False Width = 405 End Begin VB.CheckBox chkCalc Caption = "Check1" Enabled = 0 'False Height = 285 Left = 11220 TabIndex = 52 Top = 240 Width = 210 End Begin VB.TextBox txtInvDate Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3360 TabIndex = 48 TabStop = 0 'False Top = 5400 Width = 2115 End Begin VB.CommandButton cmdMisc Caption = "Add Misc Item" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 9900 TabIndex = 47 Top = 1380 Width = 1455 End Begin VB.TextBox txtNotes Height = 1995 Left = 6360 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 45 TabStop = 0 'False Top = 6300 Width = 5055 End Begin VB.CommandButton cmdFindPO Caption = "PO" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 795 Left = 2820 Picture = "frmOrders.frx":0000 Style = 1 'Graphical TabIndex = 44 TabStop = 0 'False Top = 6240 Visible = 0 'False Width = 795 End Begin Crystal.CrystalReport crOrder Left = 10200 Top = 180 _ExtentX = 741 _ExtentY = 741 _Version = 348160 PrintFileLinesPerPage= 60 End Begin VB.CommandButton cmdAR Caption = "Setup S&W AR Transfer" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 8400 TabIndex = 42 TabStop = 0 'False Top = 5160 Width = 1455 End Begin VB.CommandButton cmdPrint Caption = "&Print Invoice" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 6900 TabIndex = 41 TabStop = 0 'False Top = 5160 Width = 1455 End Begin VB.TextBox txtVendorInv BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4020 MaxLength = 10 TabIndex = 40 TabStop = 0 'False Top = 7080 Width = 1755 End Begin VB.CommandButton cmdAP Caption = "Setup A&P Transfer" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 9900 TabIndex = 38 TabStop = 0 'False Top = 5160 Width = 1455 End Begin VB.CommandButton cmdExit Caption = "E&xit" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 9900 TabIndex = 37 TabStop = 0 'False Top = 4380 Width = 1455 End Begin VB.CommandButton cmdUpdate Caption = "&Update Total" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 6900 TabIndex = 36 TabStop = 0 'False Top = 4380 Width = 1455 End Begin VB.CommandButton cmdSave Caption = "&Save" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 8400 TabIndex = 8 Top = 4380 Width = 1455 End Begin VB.TextBox txtPrice Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 7 Top = 2160 Width = 2175 End Begin VB.TextBox txtAQty Alignment = 1 'Right Justify BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 6 Top = 1740 Width = 1035 End Begin VB.ListBox lstMaterials Height = 3375 Left = 2100 TabIndex = 10 Top = 720 Width = 4155 End Begin VB.ListBox lstOrders Height = 3375 Left = 60 TabIndex = 3 TabStop = 0 'False Top = 720 Width = 1995 End Begin VB.Label lblHelp AutoSize = -1 'True Caption = "U/W" Height = 195 Left = 11040 TabIndex = 51 Top = 30 Width = 360 End Begin VB.Label lblJobCost BorderStyle = 1 'Fixed Single Height = 375 Left = 3735 TabIndex = 50 Top = 6240 Width = 1050 End Begin VB.Label lblInvDate AutoSize = -1 'True Caption = "Inv. Date:" Height = 195 Left = 5520 TabIndex = 49 Top = 5520 Width = 705 End Begin VB.Label lblNotes AutoSize = -1 'True Caption = "Notes:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 6420 TabIndex = 46 Top = 6060 Width = 570 End Begin VB.Line Line2 BorderWidth = 2 X1 = 6360 X2 = 11400 Y1 = 6000 Y2 = 6000 End Begin VB.Label lblLocked Caption = "This Invoice Has Been Transfered To AP And Is Now Locked" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 1155 Left = 120 TabIndex = 43 Top = 4140 Visible = 0 'False Width = 6075 End Begin VB.Label lblVendorInv Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Vendor Invoice #:" Height = 195 Left = 2640 TabIndex = 39 Top = 7155 Width = 1275 End Begin VB.Label lblD_Update BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6780 TabIndex = 35 Top = 3900 Width = 4575 End Begin VB.Label lblD_Create BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6780 TabIndex = 34 Top = 3240 Width = 4575 End Begin VB.Label lblD_Flag BackColor = &H80000005& BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 375 Left = 7500 TabIndex = 33 Top = 2580 Width = 3855 End Begin VB.Label lblD_OQty Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 32 Top = 1320 Width = 1035 End Begin VB.Label lblUpdate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Updated:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 6780 TabIndex = 31 Top = 3660 Width = 975 End Begin VB.Label lblCreate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Created:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 6780 TabIndex = 30 Top = 3000 Width = 900 End Begin VB.Label lblPrice Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Price:" Height = 195 Left = 6930 TabIndex = 29 Top = 2340 Width = 405 End Begin VB.Label lblAQty Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Actual Qty:" Height = 195 Left = 6555 TabIndex = 28 Top = 1800 Width = 780 End Begin VB.Label lblOQty Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Original Qty:" Height = 195 Left = 6480 TabIndex = 27 Top = 1320 Width = 855 End Begin VB.Label lblD_Desc BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 26 Top = 900 Width = 3855 End Begin VB.Label lblD_InvNo BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 25 Top = 480 Width = 2625 End Begin VB.Label lblInv_No Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Inventory:" Height = 195 Left = 6630 TabIndex = 24 Top = 600 Width = 705 End Begin VB.Label lblD_Type BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 23 Top = 7920 Width = 3555 End Begin VB.Label lblD_Supplier BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 22 Top = 7500 Width = 4575 End Begin VB.Label lblD_Percent Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 21 Top = 7080 Width = 1035 End Begin VB.Label lblD_Amount Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 20 Top = 6660 Width = 1545 End Begin VB.Label lblD_SPO BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 19 Top = 6240 Width = 1545 End Begin VB.Label lblD_PO BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 18 Top = 5820 Width = 3555 End Begin VB.Label lblD_ODate Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 17 Top = 5400 Width = 2115 End Begin VB.Label lblSPO Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Special PO #:" Height = 195 Left = 120 TabIndex = 16 Top = 6345 Width = 990 End Begin VB.Label lblType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Order Type:" Height = 195 Left = 270 TabIndex = 15 Top = 7980 Width = 840 End Begin VB.Label lblSupplier Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Supplier:" Height = 195 Left = 495 TabIndex = 14 Top = 7575 Width = 615 End Begin VB.Label lblPercent Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Percentage:" Height = 195 Left = 240 TabIndex = 13 Top = 7155 Width = 870 End Begin VB.Label lblAmount Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Order Amount:" Height = 195 Left = 90 TabIndex = 12 Top = 6750 Width = 1020 End Begin VB.Label lblPO Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "PO Number:" Height = 195 Left = 240 TabIndex = 11 Top = 5925 Width = 870 End Begin VB.Label lblO_Date Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Order Date:" Height = 195 Left = 285 TabIndex = 9 Top = 5520 Width = 825 End Begin VB.Line Line1 BorderWidth = 2 X1 = 6360 X2 = 6360 Y1 = 0 Y2 = 6000 End Begin VB.Label lblTotal Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 7500 TabIndex = 5 Top = 60 Width = 1695 End Begin VB.Label lblInvTotal AutoSize = -1 'True Caption = "PO Total:" Height = 195 Left = 6720 TabIndex = 4 Top = 120 Width = 675 End Begin VB.Label lblMatList AutoSize = -1 'True Caption = "Materials" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 2160 TabIndex = 2 Top = 480 Width = 780 End Begin VB.Label lblPOList AutoSize = -1 'True Caption = "PO Number" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 120 TabIndex = 1 Top = 480 Width = 975 End Begin VB.Label lblProjLot BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 60 TabIndex = 0 Top = 60 Width = 6195 End End Attribute VB_Name = "frmOrders" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRSORDER As Recordset Dim moRSOrdMat As Recordset Dim moRSProj As Recordset Dim moRS As Recordset Dim mboolSHOW As Boolean Dim mboolAdding As Boolean, mstrPROJLOT As String Dim mboolCopy As Boolean, mintBOOKMARK As Integer, mintBOOKMARK2 As Integer Dim mstrType As String, mstrMODEL As String, mintBOOKMARK4 As Integer Dim mlngORDERID As Long, mdblTOTAL As Double Dim mstrSQL As String Private Sub OrderLoad() Dim oRS As Recordset, oRSS As Recordset Dim strSQL As String, strSQLL As String Dim strLine As String On Error GoTo Error_EH If gintORDER = 9 Then strSQL = "SELECT * from tblOrders WHERE Lot_id = " & gintLOTID & " ORDER BY PO_Num" End If If gintORDER = 8 Then strSQL = "SELECT * from tblOrders WHERE PO_Num = '" & gstrPONUM & "'" End If Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstOrders.Clear Do Until oRS.EOF With lstOrders strLine = oRS!po_num ' & vbTab & oRS!Desc .AddItem strLine .ItemData(.NewIndex) = oRS!order_id End With oRS.MoveNext Loop oRS.Close If lstOrders.ListCount Then lstOrders.ListIndex = 0 txtOrdCnt = Field2Str(lstOrders.ListCount) End If Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAP_Click() Dim intBookmark As Integer moRSORDER!ap = vbTrue moRSORDER!cocode = moRSProj!cocode moRSORDER.Update intBookmark = lstOrders.ListIndex Call OrderLoad lstOrders.ListIndex = intBookmark End Sub Private Sub cmdAR_Click() Dim oRS As Recordset Dim strSQL As String, lngINVNO As Long On Error GoTo Error_EH strSQL = "SELECT * FROM tblSYSInfo" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic lngINVNO = Field2Long(oRS!swinvno) lngINVNO = lngINVNO + 1 If lngINVNO > 99999 Then lngINVNO = 19999 End If oRS!swinvno = lngINVNO oRS.Update moRSORDER!Vend_Inv = lngINVNO ' moRSORDER!SUP_INV = lngINVNO txtVendorInv = lngINVNO moRSORDER!ar = vbTrue moRSORDER!cocode = moRSProj!cocode moRSORDER.Update Exit Sub Error_EH: gstrMODULE = "Form Orders - Module cmdAR" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdFindPO_Click() gintPONUM = Field2Long(lblD_SPO) frmPOInfo.Show 1 End Sub Private Sub cmdMisc_Click() Dim strSql2 As String, strTYPE As String, strPONUM As String Dim lngORDERID As Long, intBookmark As Integer Dim oRSS As Recordset On Error GoTo Error_EH If moRSORDER!ap Then MsgBox "AP has been transfered, No Adding Allowed", vbOKOnly, "No Adding" Exit Sub End If If moRSORDER!ap_trans Then MsgBox "AP has been transfered, No Adding Allowed", vbOKOnly, "No Adding" Exit Sub End If If moRSORDER!ar Then MsgBox "AR has been transfered, No Adding Allowed", vbOKOnly, "No Adding" Exit Sub End If If moRSORDER!ar_trans Then MsgBox "AR has been transfered, No Adding Allowed", vbOKOnly, "No Adding" Exit Sub End If strSql2 = "SELECT * FROM tblORDMatrl WHERE order_id = 1" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic ' gstrMODULE = "Before Setup Materials " With oRSS strTYPE = moRSORDER!m_type strPONUM = moRSORDER!po_num lngORDERID = moRSORDER!order_id .AddNew !order_id = lngORDERID !LOT_ID = gintLOTID !po_num = strPONUM !d_flag = "S" !m_type = strTYPE !inv_no = "9990" !Desc = "MISC CHARGE - SEE NOTES" !o_qty = 0 !a_qty = 0 !price = 0 !Update = Date !U_USER = gstrLOGIN !C_USER = gstrLOGIN .Update End With intBookmark = lstOrders.ListIndex Call OrderLoad lstOrders.ListIndex = intBookmark Exit Sub Error_EH: gstrMODULE = "Form Orders - Module cmdMisc" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPrint_Click() Dim strSQL As String On Error GoTo Error_EH gintCOPY = 1 strSQL = "{tblORDERS.order_id} = " & mlngORDERID crOrder.ReportFileName = App.Path & "\POPrice.rpt" crOrder.GroupSelectionFormula = strSQL crOrder.CopiesToPrinter = gintCOPY ' crOrder.Destination = crptToWindow crOrder.Destination = crptToPrinter crOrder.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form Orders - Module cmdPrint" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdUpdate_Click() Dim intBOOK As Integer On Error GoTo Error_EH mintBOOKMARK = lstOrders.ListIndex intBOOK = lstMaterials.ListIndex moRSORDER!orderamt = Field2Str2(lblTotal) moRSORDER!notes = Field2Str(txtNotes) moRSORDER!Vend_Inv = Field2Str(txtVendorInv) ' moRSORDER!SUP_INV = Field2Str(txtVendorInv) moRSORDER!inv_date = Field2Str(txtInvDate) moRSORDER.Update Call OrderLoad Call OrderMatLoad cmdUpdate.Enabled = False lstOrders.ListIndex = mintBOOKMARK lstMaterials.ListIndex = intBOOK mintBOOKMARK = 0 Exit Sub Error_EH: gstrMODULE = "Form Orders - Module cmdUpdate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown ' R Reset Purchase Order for AR(Not Allowed if VOIDED) ' P Reset Purchase Order for AP(Not Allowed if VOIDED) ' V Will Void The PO if it has not been processed ' U Update the Costs for the materials in the HiLited PO for all item numbers over 1000 ' W Update the Costs for the materials in all PO's for all items numbers over 1000 ' H Update the Costs for the Hi-lited inventory item. ' I Update cost for items under inventory # 1000. Will prompt for the amount and move to the next item. If Shift = 4 Then Exit Sub End If ShiftDown = (Shift And vbShiftMask) > 0 AltDown = (Shift And vbAltMask) > 0 CtrlDown = (Shift And vbCtrlMask) > 0 If KeyCode = vbKeyR And gbytSECURITY < 3 Then ' Display key combinations. If CtrlDown Then If moRSORDER!d_flag = "X" Then MsgBox "This PO Has Been Voided - Reset Not Allowed", vbCritical + vbOKOnly, "No Void Allowed" Exit Sub End If moRSORDER!ar_trans = vbUnchecked moRSORDER!ar = vbUnchecked Call cmdUpdate_Click End If Exit Sub End If If KeyCode = vbKeyP And gbytSECURITY < 3 Then ' Display key combinations. If CtrlDown Then If moRSORDER!d_flag = "X" Then MsgBox "This PO Has Been Voided - Reset Not Allowed", vbCritical + vbOKOnly, "No Void Allowed" Exit Sub End If moRSORDER!ap_trans = vbUnchecked moRSORDER!ap = vbUnchecked Call cmdUpdate_Click End If Exit Sub End If If KeyCode = vbKeyV And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then If CtrlDown Then If moRSORDER!ar_trans Or moRSORDER!ap_trans Then MsgBox "This PO Has Already Been Processed - No Void Allowed", vbCritical + vbOKOnly, "No Void Allowed" Exit Sub End If Call LotChange(mstrPROJLOT, "VOID Purchase Order") moRSORDER!m_type = "H" moRSORDER!d_flag = "X" moRSORDER!ar_trans = vbChecked moRSORDER!ap_trans = vbChecked moRSORDER.Update Call FormShow End If Exit Sub End If If KeyCode = vbKeyU And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then If CtrlDown Then Call OrderMatPrices Call OrderMatLoad End If Exit Sub End If If KeyCode = vbKeyW And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then If CtrlDown Then Call OrderMatPrices2 Call OrderMatLoad End If Exit Sub End If If KeyCode = vbKeyH And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then If CtrlDown Then Call OrderMatPrices4 mintBOOKMARK4 = lstMaterials.ListIndex mintBOOKMARK2 = lstOrders.ListIndex Call OrderMatLoad lstMaterials.ListIndex = mintBOOKMARK4 lstOrders.ListIndex = mintBOOKMARK2 mintBOOKMARK4 = 0 mintBOOKMARK2 = 0 End If Exit Sub End If If KeyCode = vbKeyI And (gbytSECURITY = 1 Or gbytSECURITY = 6) Then If CtrlDown Then Call OrderMatPrices3 Call OrderMatLoad End If Exit Sub End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim intResponse As Integer, strMSG As String On Error GoTo Error_EH If cmdSave.Enabled Then strMSG = "PO Data Has Been Changed" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Save Changes ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption) Select Case intResponse Case vbYes Call FormSave Case vbNo Case vbCancel Cancel = True Exit Sub End Select End If If moRSORDER.State = adStateOpen Then moRSORDER.Close End If If moRSOrdMat.State = adStateOpen Then moRSOrdMat.Close End If If moRS.State = adStateOpen Then moRS.Close End If If moRSProj.State = adStateOpen Then moRSProj.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next Else End If End Sub Private Sub OrderMatLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String, lngRET As Long, aTabs(1) As Long Dim dblSUM As Double On Error GoTo Error_EH aTabs(0) = 130 aTabs(1) = 155 mdblTOTAL = 0 strSQL = "SELECT Item_id, Inv_no, Desc, A_Qty, Price from tblOrdMatrl WHERE Order_id = " & mlngORDERID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lngRET = SendMessage(lstMaterials.hwnd, LB_SETTABSTOPS, 2, aTabs(0)) lstMaterials.Clear Do Until oRS.EOF With lstMaterials strLine = oRS!Desc & vbTab & oRS!a_qty & vbTab & Format(oRS!price, "#,#.00") .AddItem strLine .ItemData(.NewIndex) = oRS!Item_ID End With dblSUM = (Field2Str2(oRS!a_qty) * Field2Str2(oRS!price)) mdblTOTAL = mdblTOTAL + dblSUM oRS.MoveNext Loop oRS.Close If mdblTOTAL <> Field2Str2(lblD_Amount) Then lblD_Amount = Format(mdblTOTAL, "#,#,#.00") moRSORDER!orderamt = mdblTOTAL moRSORDER.Update End If If lstMaterials.ListCount Then lstMaterials.ListIndex = 0 Else lstMaterials.Clear Call FormClearOrdMat End If lblTotal = Format(mdblTOTAL, "#,#.00") Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderMatLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_Load() ' Set moRSORDER = New Recordset ' Set moRSOrdMat = New Recordset ' If gbytSECURITY < 3 Then ' cmdUpdate.Visible = True ' End If Call ProjLoad Call OrderLoad If gstrPONUM = "" Then Else Call CBFindString(lstOrders, gstrPONUM) ' lstOrders.SetFocus End If ' Call ListLoad ' Call MatLoad ' Call OptLoad ' Call OptMatLoad End Sub Private Sub FormShow() On Error GoTo Error_EH mboolSHOW = True mlngORDERID = moRSORDER!order_id glngORDERID = moRSORDER!order_id lblProjLot = Trim$(moRSProj!Proj_Code) & " " & Trim$(moRSProj!Proj_Desc) & " " & moRS!lot_no mstrPROJLOT = lblProjLot With moRSORDER txtVendorInv = Field2Str(!Vend_Inv) ' txtVendorInv = Field2Str(!SUP_INV) txtNotes = Field2Str(!notes) chkCalc = Field2CheckBox(!calc) lblJobCost = Field2Str(!jobcost) lblD_ODate = Field2Str(!order_date) If !d_flag = "X" Then lblD_Flag = "This PO Voided - Do Not Pay" Else lblD_Flag = "" End If If IsNull(!inv_date) Then txtInvDate = Field2Str(!order_date) Else txtInvDate = Field2Str(!inv_date) End If lblD_PO = Field2Str(!po_num) lblD_Supplier = Field2Str(!supplier) lblD_SPO = Field2Long(!ponum) lblD_Percent = Field2Str(!percentage) lblD_Amount = Format(Field2Str2(!orderamt), "#,#.00") If !m_type = "H" Then lblD_Type = "ORDER REPRINTED" ElseIf !m_type = "L" Then lblD_Type = "LATH ORDER" ElseIf !m_type = "A" Then lblD_Type = "SAND ORDER" ElseIf !m_type = "B" Then lblD_Type = "BROWN ORDER" ElseIf !m_type = "T" Then lblD_Type = "TEXTURE ORDER" ElseIf !m_type = "R" Then lblD_Type = "SPECIAL PO" ElseIf !m_type = "P" Then lblD_Type = "PREORDER" ElseIf !m_type = "S" Then lblD_Type = "SCRATCH ORDER" ElseIf !m_type = "V" Then lblD_Type = "STONE VENEER ORDER" ElseIf !m_type = "W" Then lblD_Type = "TYPAR WRAP ORDER" Else lblD_Type = "UNKNOWN" End If lblLocked.Caption = "" cmdAP.Caption = "Setup AP Transfer" cmdAR.Caption = "Setup AR Transfer" cmdAP.Enabled = True cmdAR.Enabled = True If !ap Then lblLocked.Caption = "This Invoice Ready To Be Transfered To AP" lblLocked.Visible = True txtVendorInv.Enabled = False txtAQty.Enabled = False txtPrice.Enabled = False txtInvDate.Enabled = False cmdAP.Caption = "AP Transfer Setup" ' cmdAR.Enabled = False cmdAP.Enabled = False End If If !ap_trans Then lblLocked.Caption = "This Invoice Has Been Transfered To AP" lblLocked.Visible = True txtVendorInv.Enabled = False txtAQty.Enabled = False txtPrice.Enabled = False txtInvDate.Enabled = False cmdAP.Caption = "AP Transfered" ' If !ar_trans Then ' cmdAR.Caption = "AR Transfered" ' End If ' cmdAR.Enabled = False cmdAP.Enabled = False End If If !ar Then lblLocked.Caption = lblLocked.Caption & " This Invoice Ready To Be Transfered To AR" lblLocked.Visible = True txtVendorInv.Enabled = False txtAQty.Enabled = False txtPrice.Enabled = False txtInvDate.Enabled = False cmdAR.Caption = "AR Transfer Setup" cmdAR.Enabled = False ' cmdAP.Enabled = True End If If !ar_trans Then lblLocked.Caption = lblLocked.Caption & " This Invoice Has Been Transfered To AR" lblLocked.Visible = True txtVendorInv.Enabled = False txtAQty.Enabled = False txtPrice.Enabled = False txtInvDate.Enabled = False cmdAR.Caption = "AR Transfered" cmdAR.Enabled = False ' cmdAP.Enabled = True End If If !ar_trans And !ap_trans Then lblLocked.Caption = lblLocked.Caption & " And Is Now Locked" lblLocked.Visible = True txtVendorInv.Enabled = False txtAQty.Enabled = False txtPrice.Enabled = False txtInvDate.Enabled = False cmdAP.Caption = "AP Transfered" cmdAR.Caption = "AR Transfered" cmdAR.Enabled = False cmdAP.Enabled = False End If If Not !ar_trans And Not !ap_trans And Not !ap And Not !ar Then lblLocked.Visible = False txtVendorInv.Enabled = True txtAQty.Enabled = True txtPrice.Enabled = True txtInvDate.Enabled = True cmdAP.Caption = "Setup A&P Transfer" cmdAR.Caption = "Setup S&W AR Transfer" cmdAR.Enabled = True cmdAP.Enabled = True End If If lblD_SPO > 0 Then cmdFindPO.Visible = True Else cmdFindPO.Visible = False End If txtNotes = Field2Str(!notes) End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Orders - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShowOrdMat() On Error GoTo Error_EH mboolSHOW = True With moRSOrdMat lblD_InvNo = Field2Long(!inv_no) lblD_Desc = Field2Str(!Desc) lblD_OQty = Field2Str(!o_qty) txtPrice = Format$(Field2Str2(!price), "##,###.00") txtAQty = Field2Integer(!a_qty) lblD_Create = Field2Str(!Create) lblD_Update = Field2Str(!Update) & " " & Field2Str(!U_USER) End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Orders - Module FormShowMat" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormClear() lblD_ODate = "" lblD_PO = "" lblSupplier = "" lblD_SPO = "" lblD_Percent = "" lblD_Amount = "" lblD_Type = "" lblD_Flag = "" End Sub Private Sub FormClearOrdMat() lblD_InvNo = "" lblD_Desc = "" lblD_OQty = 0 txtPrice = 0 txtAQty = 0 lblCreate = "" lblUpdate = "" End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH Call FieldsSave moRSOrdMat.Update Call OrderMatLoad ' Call ToggleButtons Exit Sub Error_EH: Call ErrorHandler(moRS.ActiveConnection) Exit Sub End Sub Private Function FormFind() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblOrders " strSQL = strSQL & "WHERE order_id = " & _ lstOrders.ItemData(lstOrders.ListIndex) Set moRSORDER = New Recordset moRSORDER.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSORDER.EOF Then FormFind = False Else FormFind = True End If Exit Function Error_EH: gstrMODULE = "Form Orders - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindOrdMat() As Boolean Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblOrdMatrl " strSQL = strSQL & "WHERE Item_ID = " & lstMaterials.ItemData(lstMaterials.ListIndex) Set moRSOrdMat = New Recordset moRSOrdMat.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRSOrdMat.EOF Then FormFindOrdMat = False txtAQty.Enabled = False txtPrice.Enabled = False Else FormFindOrdMat = True ' txtAQty.Enabled = True ' txtPrice.Enabled = True End If Exit Function Error_EH: gstrMODULE = "Form Orders - Module FormFindOrdMat" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FieldsSave() On Error GoTo Error_EH With moRSOrdMat !a_qty = Single2Field(txtAQty) !price = Format(Single2Field(txtPrice), "#,#.00") ' If txtAQty > 0 Then ' !SWAR = True ' End If ' !notes = Str2Field(txtNotes) !Update = Date !U_USER = gstrLOGIN End With Exit Sub Error_EH: gstrMODULE = "Form Orders - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String If lstOrders.ListCount = 0 Then intResponse = MsgBox("No Orders Have Been Processed For This Lot", vbOKOnly + vbQuestion, "No Orders") Unload Me End If End Sub Private Sub lstMaterials_DblClick() If Not moRSORDER!ap_trans Then cmdSave.Enabled = True End If End Sub Private Sub lstOrders_Click() On Error GoTo Error_EH If lstOrders.ListIndex <> -1 Then If FormFind() Then Call FormShow Call OrderMatLoad If lstMaterials.ListIndex <> -1 Then If FormFindOrdMat() Then Call FormShowOrdMat Else lstMaterials.Clear txtAQty.Enabled = False txtPrice.Enabled = False Call FormClearOrdMat End If Else txtAQty.Enabled = False txtPrice.Enabled = False End If Else lstOrders.Clear Call FormClear End If End If Exit Sub Error_EH: gstrMODULE = "Form Orders - Module lstOrders_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstMaterials_Click() On Error GoTo Error_EH If lstMaterials.ListIndex <> -1 Then If FormFindOrdMat() Then Call FormShowOrdMat Else lstMaterials.Clear Call FormClearOrdMat End If End If Exit Sub Error_EH: gstrMODULE = "Form Orders - Module lstMaterials_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ProjLoad() Dim strSQL As String Dim strSql2 As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID Set moRSProj = New Recordset moRSProj.Open strSQL, goConn, _ adOpenForwardOnly, adLockReadOnly strSql2 = "SELECT * FROM tblLotInfo WHERE Lot_id = " & gintLOTID Set moRS = New Recordset moRS.Open strSql2, goConn, adOpenForwardOnly, adLockReadOnly Exit Sub Error_EH: gstrMODULE = "Form Orders - Module ProjLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSave_Click() Dim intBOOK As Integer mintBOOKMARK = lstOrders.ListIndex intBOOK = lstMaterials.ListIndex cmdExit.Enabled = True cmdSave.Enabled = False cmdUpdate.Enabled = True Call FormSave lstOrders.ListIndex = mintBOOKMARK lstMaterials.ListIndex = intBOOK mintBOOKMARK = 0 End Sub Private Sub lstOrders_DblClick() If chkCalc Then chkCalc = vbUnchecked moRSORDER!calc = False moRSORDER.Update Else chkCalc = vbChecked moRSORDER!calc = True moRSORDER.Update End If End Sub Private Sub txtAQty_GotFocus() Call FieldSelect(txtAQty) End Sub Private Sub txtInvDate_Change() cmdUpdate.Enabled = True End Sub Private Sub txtInvDate_GotFocus() Call FieldSelect(txtInvDate) End Sub Private Sub txtInvDate_LostFocus() Dim lngPOS As Long lngPOS = InStr(1, txtInvDate, "/", 1) If Not IsDate(txtInvDate) Then If lngPOS = 0 Then If Len(txtInvDate) > 0 Then txtInvDate = Format(txtInvDate, "00/00/####") If Not IsDate(txtInvDate) Then MsgBox "The Date You Entered is not Valid - ReEnter" txtInvDate.SetFocus Exit Sub End If End If Else MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter" txtInvDate.SetFocus Exit Sub End If End If cmdUpdate.SetFocus End Sub Private Sub txtNotes_Change() cmdUpdate.Enabled = True End Sub Private Sub txtNotes_GotFocus() txtNotes.SelStart = 1000 End Sub Private Sub txtNotes_LostFocus() txtNotes = UCase(txtNotes) txtVendorInv.SetFocus End Sub Private Sub txtPrice_GotFocus() Call FieldSelect(txtPrice) End Sub Private Sub txtVendorInv_Change() cmdUpdate.Enabled = True End Sub Private Sub txtVendorInv_GotFocus() Call FieldSelect(txtVendorInv) End Sub Private Sub txtVendorInv_LostFocus() txtVendorInv = UCase(txtVendorInv) cmdUpdate.SetFocus End Sub Private Sub SetupTransfer() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset On Error GoTo Error_EH strSQL = "SELECT * FROM tblARINVOICE WHERE ready" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic strSql2 = "DELETE * FROM tblARTRANS" goConn.Execute strSql2 strSql2 = "SELECT * FROM tblARTRANS" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF With oRSS .AddNew !invoice_no = oRS!invoice_no !customer_no = oRS!customer_no !invoice_date = oRS!invoice_date !job_number = oRS!job_number !inv_due_date = oRS!inv_due_date !disc_due_date = oRS!disc_due_date !non_tax_amt = oRS!non_tax_amt !retention_amt = oRS!retention_amt !sales_code = oRS!sales_code !Description = Left$(Field2Str(oRS!Description), 30) !price = oRS!price !amount = oRS!amount !ready = True !shipping = Left$(Field2Str(oRS!project), 15) !comment = "Lot " & oRS!lot_no & "," & Left$(Field2Str(oRS!address), 20) .Update oRS!ready = False oRS!done = True oRS.Update oRS.MoveNext End With Loop Exit Sub Error_EH: gstrMODULE = "Form MAIN - Module SetupTransfer" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub WrapMatPrices() Dim oRS As Recordset, oRSS As Recordset, strINV As String Dim strSQL As String, strSQLL As String On Error GoTo Error_EH strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then Do Until oRS.EOF strINV = Field2Str(oRS!inv_no) If strINV < "1000" Then Else ' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSS.EOF Then oRS!price = Field2Str2(oRSS!price) oRS.Update End If oRSS.Close End If oRS.MoveNext Loop End If Exit Sub Error_EH: gstrMODULE = "Form Orders - Module WrapMatPrices" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OrderMatPrices() Dim oRS As Recordset, oRSS As Recordset, strINV As String Dim strSQL As String, strSQLL As String On Error GoTo Error_EH strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & glngORDERID ' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then Do Until oRS.EOF strINV = Field2Str(oRS!inv_no) If strINV < "1000" Then Else ' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSS.EOF Then If Field2Str2(oRS!price) = 0 Then oRS!price = Field2Str2(oRSS!price) oRS.Update End If End If oRSS.Close End If oRS.MoveNext Loop End If Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderMatPrices" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OrderMatPrices2() Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer On Error GoTo Error_EH intLSTCNT = Field2Integer(txtOrdCnt) intCOUNT = 1 lstOrders.ListIndex = 0 lngORDERID = lstOrders.ItemData(lstOrders.ListIndex) Do Until intCOUNT = intLSTCNT If chkCalc Then strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & glngORDERID ' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then Do Until oRS.EOF strINV = Field2Str(oRS!inv_no) If strINV < "1000" Then Else ' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSS.EOF Then oRS!price = Field2Str2(oRSS!price) oRS.Update End If oRSS.Close End If oRS.MoveNext Loop End If End If intCOUNT = intCOUNT + 1 Loop Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderMatPrices2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OrderMatPrices3() Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer On Error GoTo Error_EH intLSTCNT = Field2Integer(txtOrdCnt) intCOUNT = 1 lstOrders.ListIndex = 0 lngORDERID = lstOrders.ItemData(lstOrders.ListIndex) Do Until intCOUNT = intLSTCNT If chkCalc Then strSQL = "SELECT Lot_ID, INV_NO, Price, ORDER_ID FROM tblORDMATRL WHERE ORDER_ID = " & lngORDERID & " AND INV_NO = " ' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then Do Until oRS.EOF strINV = Field2Str(oRS!inv_no) If strINV < "1000" Then Else ' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSS.EOF Then oRS!price = Field2Str2(oRSS!price) oRS.Update End If oRSS.Close End If oRS.MoveNext Loop End If End If intCOUNT = intCOUNT + 1 Loop Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderMatPrices3" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OrderMatPrices4() Dim oRS As Recordset, oRSS As Recordset, strINV As String, lngORDERID As Long, strCOST As String Dim strSQL As String, strSQLL As String, intLSTCNT As Integer, intCOUNT As Integer, dblCOST As Double Dim strDESC As String On Error GoTo Error_EH intLSTCNT = Field2Integer(txtOrdCnt) ' intCOUNT = 1 ' lstOrders.ListIndex = 0 ' lngORDERID = lstOrders.ItemData(lstOrders.ListIndex) ' lstMaterials.ListIndex = 0 lngORDERID = lstMaterials.ItemData(lstMaterials.ListIndex) ' Do Until intCOUNT = intLSTCNT ' If chkCalc Then strSQL = "SELECT Lot_ID, INV_NO, DESC, Price, ITEM_ID FROM tblORDMATRL WHERE ITEM_ID = " & lngORDERID ' & " AND INV_NO = " ' strSQL = "SELECT Lot_ID, M_Type, INV_NO, QTY, Price FROM tblLOTMATRL WHERE M_TYPE = 'W' and LOT_ID = " & gintLOTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then ' Do Until oRS.EOF strINV = Field2Str(oRS!inv_no) strDESC = Field2Str(oRS!Desc) If Field2Str2(oRS!price) = 0 Then strCOST = InputBox("Enter The New Cost For '" & Trim(Field2Str(oRS!inv_no)) & " - " & Trim(Field2Str(oRS!Desc)) & "'", "Update Material Cost", 0) oRS!price = Field2Str2(strCOST) oRS.Update Else MsgBox "Price Is Not Zero So Cannot Be Updated", vbOKOnly, "Cannot Update" ' strSQLL = "SELECT INV_NO, M_TYPE, Price, Inv_Type FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = '" & Field2Str(oRS!inv_no) & "'" ' strSQLL = "SELECT * FROM tblINVTRY WHERE INV_TYPE = " & gbytINV_TYPE & " AND INV_NO = " & Field2Str(oRS!Inv_NO) ' & "'" ' Set oRSS = New Recordset ' oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockReadOnly ' If Not oRSS.EOF Then ' oRS!price = Field2Str2(oRSS!price) ' oRS.Update ' End If ' oRSS.Close End If ' oRS.MoveNext ' Loop End If ' End If ' intCOUNT = intCOUNT + 1 ' Loop Exit Sub Error_EH: gstrMODULE = "Form Orders - Module OrderMatPrices4" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub