VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmPO Caption = "Purchase Order Selection " ClientHeight = 8670 ClientLeft = 165 ClientTop = 735 ClientWidth = 12045 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 8670 ScaleWidth = 12045 StartUpPosition = 3 'Windows Default Visible = 0 'False WindowState = 2 'Maximized Begin VB.CommandButton cmdPONotes Caption = "PO 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 = 270 Left = 10935 TabIndex = 55 Top = 5145 Visible = 0 'False Width = 1080 End Begin LpLib.fpList lstHistory Height = 840 Left = 3735 TabIndex = 53 Top = 4290 Width = 8010 _Version = 196608 _ExtentX = 14129 _ExtentY = 1482 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = 16578720 ForeColor = -2147483640 Columns = 7 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 195 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPO.frx":0000 End Begin VB.CheckBox chkHistory Caption = "Check to Use CMS Inventory List for CTRL-O" Height = 240 Left = 105 TabIndex = 51 Top = 7530 Width = 3600 End Begin VB.CommandButton cmdAlias Caption = "Alias" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 6555 TabIndex = 49 Top = 900 Visible = 0 'False Width = 735 End Begin VB.CheckBox chkNoDisplay Caption = "Skip Display" Height = 240 Left = 2115 TabIndex = 48 Top = 7320 Visible = 0 'False Width = 585 End Begin VB.CheckBox chkOKPO Caption = "Do Not Create" Height = 240 Left = 1365 TabIndex = 47 Top = 7335 Visible = 0 'False Width = 510 End Begin VB.CheckBox chkByDesc Caption = "PO By Description" Height = 210 Left = 4845 TabIndex = 46 Top = 1245 Width = 1620 End Begin VB.CommandButton cmdAPAR Caption = "AP/AR Check" Height = 300 Left = 3915 TabIndex = 45 Top = 7530 Visible = 0 'False Width = 1245 End Begin VB.CommandButton cmdPromo Caption = "Promo" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 10830 TabIndex = 44 Top = 495 Width = 1035 End Begin VB.CommandButton cmdOnOrder Caption = "OnOrder List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 9990 TabIndex = 43 ToolTipText = "This Will Display The Outstanding PO's For The Hi-Lited Inventory Item" Top = 900 Width = 840 End Begin VB.CommandButton cmdAltVend2 Caption = "Vendor Stock List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 10830 TabIndex = 40 Top = 15 Width = 1035 End Begin VB.CheckBox chkKEEP Caption = "Keep Search Info" Height = 210 Left = 1770 TabIndex = 38 Top = 1245 Value = 1 'Checked Width = 1680 End Begin VB.Timer tmrAltVend Left = 3375 Top = 7215 End Begin VB.CommandButton cmdAltVendor Caption = "Vendor Stock #" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Left = 8355 TabIndex = 37 Top = 600 Visible = 0 'False Width = 1650 End Begin VB.CheckBox chkZero Caption = "No Zero Qty" Height = 210 Left = 3510 TabIndex = 36 Top = 1245 Value = 1 'Checked Width = 1260 End Begin VB.CommandButton cmdMinMax2 Caption = "Update Order List Min/Max" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 675 Left = 2535 TabIndex = 30 Top = 4305 Width = 1215 End Begin VB.CommandButton cmdSales Caption = "Calc Sales" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 7260 TabIndex = 29 Top = 585 Visible = 0 'False Width = 1095 End Begin VB.TextBox txtBegDate Height = 285 Left = 5580 TabIndex = 26 Top = 660 Width = 975 End Begin VB.TextBox txtEndDate Height = 285 Left = 5580 TabIndex = 25 Top = 960 Width = 975 End Begin VB.CommandButton cmdPrint Caption = "Print Order Checklist" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 7305 TabIndex = 24 Top = 900 Width = 1050 End Begin VB.CommandButton cmdMINMAX Caption = "Update Inv List - MIN/MAX && Type" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8370 TabIndex = 23 Top = 900 Width = 1620 End Begin VB.CommandButton cmdLabel Caption = "Setup BC Labels" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 480 Left = 10830 TabIndex = 21 Top = 975 Width = 1035 End Begin VB.ComboBox cboSortOrder Height = 315 ItemData = "frmPO.frx":06F9 Left = 1920 List = "frmPO.frx":070C Style = 2 'Dropdown List TabIndex = 20 Top = 240 Width = 1755 End Begin MSComDlg.CommonDialog cdPO Left = 3855 Top = 7185 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin Crystal.CrystalReport crPO Left = 2865 Top = 7185 _ExtentX = 741 _ExtentY = 741 _Version = 348160 WindowControlBox= -1 'True WindowMaxButton = -1 'True WindowMinButton = -1 'True WindowState = 2 PrintFileLinesPerPage= 60 End Begin VB.TextBox txtOrderQty Alignment = 1 'Right Justify Height = 285 Left = 9975 TabIndex = 16 Tag = """OrderQty""" Top = 5130 Width = 795 End Begin VB.TextBox txtEndSelect Height = 285 Left = 5580 TabIndex = 8 Top = 360 Width = 4845 End Begin VB.TextBox txtBegSelect Height = 285 Left = 5580 TabIndex = 7 Top = 60 Width = 4845 End Begin VB.ComboBox cboSort Height = 315 ItemData = "frmPO.frx":0749 Left = 45 List = "frmPO.frx":075F Style = 2 'Dropdown List TabIndex = 3 Top = 240 Width = 1755 End Begin LpLib.fpList lstInventory Height = 2535 Left = 90 TabIndex = 0 Top = 1470 Width = 11655 _Version = 196608 _ExtentX = 20558 _ExtentY = 4471 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = -1 'True BackColor = -2147483643 ForeColor = -2147483640 Columns = 21 Sorted = 1 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = 0 ColumnWidthScale= 0 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 2 SearchMethod = 2 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 2 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 450 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPO.frx":07A9 End Begin LpLib.fpList lstProcess Height = 2040 Left = 90 TabIndex = 50 Top = 5445 Width = 11655 _Version = 196608 _ExtentX = 20558 _ExtentY = 3598 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = -1 'True BackColor = -2147483643 ForeColor = -2147483640 Columns = 16 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = 0 ColumnWidthScale= 0 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 2 SearchMethod = 2 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 300 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPO.frx":11B2 End Begin LpLib.fpCombo cboVendor Height = 315 Left = 3750 TabIndex = 41 Top = 240 Visible = 0 'False Width = 5730 _Version = 196608 _ExtentX = 10107 _ExtentY = 556 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = -1 'True BackColor = -2147483643 ForeColor = -2147483640 Text = "" Columns = 3 Sorted = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = 1 ColumnWidthScale= 2 RowHeight = -1 WrapList = 0 'False WrapWidth = 0 AutoSearch = 2 SearchMethod = 1 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 DataFieldList = "" ColumnEdit = -1 ColumnBound = -1 Style = 2 MaxDrop = 8 ListWidth = -1 EditHeight = -1 GrayAreaColor = -2147483633 ListLeftOffset = 0 ComboGap = -2 MaxEditLen = 150 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= 0 'False ColumnHeaderHeight= -1 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 EnableClickEvent= -1 'True ListPosition = 0 ButtonThreeDAppearance= 0 OLEDragMode = 0 OLEDropMode = 0 Redraw = -1 'True AutoSearchFill = 0 'False AutoSearchFillDelay= 500 EditMarginLeft = 1 EditMarginTop = 1 EditMarginRight = 0 EditMarginBottom= 3 ResizeRowToFont = 0 'False TextTipMultiLine= 0 AutoMenu = -1 'True EditAlignH = 0 EditAlignV = 0 ColDesigner = "frmPO.frx":1A84 End Begin LpLib.fpList lstCompare Height = 780 Left = 90 TabIndex = 52 Top = 7800 Width = 11715 _Version = 196608 _ExtentX = 20664 _ExtentY = 1376 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Courier New" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = 8454143 ForeColor = -2147483640 Columns = 8 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 240 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPO.frx":20DB End Begin VB.TextBox txtSearch Height = 285 Left = 60 TabIndex = 5 Top = 840 Width = 2520 End Begin VB.Label lblMessage BackColor = &H0000FFFF& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 270 Left = 75 TabIndex = 54 Top = 4005 Visible = 0 'False Width = 11670 End Begin VB.Label lblWait Alignment = 2 'Center BackColor = &H00FF0000& Caption = "Please Wait" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 645 Left = 2580 TabIndex = 31 Top = 615 Visible = 0 'False Width = 1800 End Begin VB.Label lblSelectVend Caption = "Select Vendor and Press ENTER to Complete PO" Height = 240 Left = 3720 TabIndex = 42 Top = 0 Visible = 0 'False Width = 6045 End Begin VB.Label lblTest BeginProperty Font Name = "Arial" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 720 Left = 90 TabIndex = 39 Top = 4350 Width = 2250 End Begin VB.Label txtPOTotal Height = 195 Left = 10665 TabIndex = 35 Top = 7545 Width = 1065 End Begin VB.Label lblPOTotalAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Estimated PO Total:" 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 = 8895 TabIndex = 34 Top = 7545 Width = 1710 End Begin VB.Label lblWeight Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "TTL Weight" 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 = 6780 TabIndex = 33 Top = 7545 Width = 1020 End Begin VB.Label txtWeight Alignment = 2 'Center Height = 195 Left = 7890 TabIndex = 32 Top = 7545 Width = 975 End Begin VB.Label lblEndDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Ending Date:" Height = 195 Left = 4560 TabIndex = 28 Top = 1020 Width = 930 End Begin VB.Label lblBegDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Beginning Date:" Height = 195 Left = 4380 TabIndex = 27 Top = 720 Width = 1140 End Begin VB.Label lblUser Caption = "User: " 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 = 3150 TabIndex = 22 Top = 885 Width = 1185 End Begin VB.Label lblSort2 Caption = "Sort Field - Order List" Height = 255 Left = 1920 TabIndex = 19 Top = 0 Width = 1635 End Begin VB.Label lblSort1 Caption = "Sort Field - Inventory" Height = 240 Left = 0 TabIndex = 18 Top = 0 Width = 1635 End Begin VB.Label lblOrderHold Height = 315 Left = 11490 TabIndex = 17 Top = 3945 Visible = 0 'False Width = 615 End Begin VB.Label lblOrder Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Order Qty:" Height = 195 Left = 9180 TabIndex = 15 Top = 5145 Width = 720 End Begin VB.Label lblShowDesc BorderStyle = 1 'Fixed Single Height = 255 Left = 4560 TabIndex = 14 Top = 5115 Width = 4515 End Begin VB.Label lblDesc Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Description:" Height = 195 Left = 3660 TabIndex = 13 Top = 5145 Width = 840 End Begin VB.Label lblStock BorderStyle = 1 'Fixed Single Caption = " " Height = 255 Left = 1860 TabIndex = 12 Top = 5115 Width = 1755 End Begin VB.Label lblStockNo Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Stock #:" Height = 195 Left = 1170 TabIndex = 11 Top = 5115 Width = 615 End Begin VB.Label lblEndSelect Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Ending Selection: " Height = 195 Left = 4245 TabIndex = 10 Top = 420 Width = 1290 End Begin VB.Label lblBegSelect Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Beginning Selection: " Height = 195 Left = 4035 TabIndex = 9 Top = 120 Width = 1500 End Begin VB.Label lblSearch Caption = "Enter Stock Number to Find" Height = 255 Left = 60 TabIndex = 6 Top = 600 Width = 3075 End Begin VB.Label lblSort Caption = "Sort Field - Inventory" Height = 255 Left = 60 TabIndex = 4 Top = 0 Width = 1635 End Begin VB.Label lblProcess AutoSize = -1 'True Caption = "Order List" 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 = 15 TabIndex = 2 Top = 5130 Width = 840 End Begin VB.Label lblCMS AutoSize = -1 'True Caption = "CMS Inventory List" 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 = 60 TabIndex = 1 Top = 1260 Width = 1620 End Begin VB.Menu mnuSelect Caption = "Set Selection" Begin VB.Menu mnuBegin Caption = "Beginning Selection" End Begin VB.Menu mnuEnding Caption = "Ending Selection" End Begin VB.Menu mnuBegDate Caption = "Beginning Date" End Begin VB.Menu mnuEndDate Caption = "Ending Date" End End Begin VB.Menu mnuPartial Caption = "Select By Criteria" Begin VB.Menu mnuMinMax Caption = "Select by Min/Max" End Begin VB.Menu mnuPOSSales Caption = "Select by POS Sales" End Begin VB.Menu mnuSelAll Caption = "Select ALL For 1 Vendor" End End Begin VB.Menu mnuCreate2 Caption = "Create PO" End Begin VB.Menu mnuClear Caption = "c&Lear" End Begin VB.Menu mnuReports Caption = "&Reports" End Begin VB.Menu cmdOpenPO Caption = "Open PO List" End Begin VB.Menu mnuImport Caption = "Import Electronic Invoices" Begin VB.Menu mnuCPet Caption = "Central Pet" End Begin VB.Menu mnuSunburst Caption = "Sunburst Pet" Visible = 0 'False End Begin VB.Menu mnuTVet Caption = "Thompson Vet" End Begin VB.Menu mnuLextron Caption = "Lextron" Visible = 0 'False End Begin VB.Menu mnuPurina1 Caption = "Purina (Land O Lakes)" End Begin VB.Menu mnuPurina2 Caption = "Purina (CSV Detail Old)" End Begin VB.Menu mnuPurina Caption = "Purina (CSV Detail 2016)" End Begin VB.Menu mnuEagle Caption = "Eagle - Create PO" Visible = 0 'False End End Begin VB.Menu cmdImpCMS Caption = "Import CMS PO's" Visible = 0 'False End Begin VB.Menu mnuLabels Caption = "Labels" End Begin VB.Menu mnuUpdate Caption = "Update" Begin VB.Menu mnuUpVendor Caption = "Primary Vendor" End Begin VB.Menu mnuUpDesc Caption = "Description" End Begin VB.Menu mnuUpWgt Caption = "Weight" End Begin VB.Menu mnuUpCase Caption = "Units in a Case" End End Begin VB.Menu mnuAddInv Caption = "Add Inventory" Begin VB.Menu mnuAddV Caption = "Add From Vendor" End Begin VB.Menu mnuAddS Caption = "Add From Another Store" End End Begin VB.Menu mnuExit Caption = "E&Xit" End Begin VB.Menu mnuHelp Caption = "&Help" End End Attribute VB_Name = "frmPO" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim moRSPOList As Recordset, moRSUpdate As Recordset, moRSAV As Recordset Dim moRSPOHeader As Recordset, moRSPODetail As Recordset Dim mstrBEGDATE As String, mstrENDDATE As String, mboolCTRLO As Boolean Dim mstrCUSTOMER As String * 20, mintYN As String 'Dim mstrVSTOCK As String, mstrAVENDOR As String, mstrSTOCK As String Dim mstrVSTOCK As String * 20, mstrAVENDOR As String * 20, mstrSTOCK As String * 20 Dim mstrADDVStock As String, mintBOOKMARK3 As Integer, mstrNSTOCK As String * 20 Dim mstrLine As String, strCode As String, strCompany As String Dim mstrName As String, strCUST As String, strVEND As String, strTYPE As String Dim mstrCP_PO As String, mstrDATE As String, mstrTABLE As String Dim mstrALIAS As String, mboolALIASFOUND As Boolean, mstrOldVendor As String Dim mstrVENDOR As String, mboolNOVSTOCK As Boolean, mintBOOKMARK2 As Integer Dim mstrDESC As String, mintBOOKMARK As Integer, mlngCOUNT As Long, mintBOOKMARK5 As Integer Dim mdblQORDER As Double, mboolALL As Boolean, mstrVFIND As String * 20 Dim mbytSort As Byte, mintBOOKMARK12 As Integer, mintBOOKMARK13 As Integer Dim mintCnt1 As Integer, mintCnt2 As Integer Dim mdteBegin As Date, mdteEnd As Date Dim mstrN_LPD, mstrN_Desc, mstrN_LC, mstrN_RTL, mstrN_VND, mstrN_VS As String, mstrFStock As String Dim mstrS_LPD, mstrS_Desc, mstrS_LC, mstrS_RTL, mstrS_VND, mstrS_VS As String ', mstrStore1 As String Dim mstrT_LPD, mstrT_Desc, mstrT_LC, mstrT_RTL, mstrT_VND, mstrT_VS As String ', mstrStore2 As String Dim mstrN_LM, mstrN_LY, mstrN_YA, mstrN_ICLM, mstrN_ICLY, mstrN_ICYA As String Dim mstrS_LM, mstrS_LY, mstrS_YA, mstrS_ICLM, mstrS_ICLY, mstrS_ICYA As String Dim mstrT_LM, mstrT_LY, mstrT_YA, mstrT_ICLM, mstrT_ICLY, mstrT_ICYA As String Dim mstrT_TY, mstrN_TY, mstrS_TY As String 'vbDefaultButton2 Private Sub InventoryLoad() Dim oSTATUS As Long, oRSAV As Recordset, strSQLAV As String Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim lngBUYCON As Long, dblBUYCON As Double, lngSTDCST As Long, dblSTDCST As Double Dim lngWEIGHT As Long, dblWEIGHT As Double Dim lngONORDER As Long, dblONORDER As Double Dim lngCSQty As Long, strCSQty As String Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long Dim strLOrder As String, strLPur As String, strLSALE As String, strTStock As String Dim strWeight As String, intMIN As Integer, strFIND As String, strTVend As String Dim strVSTOCK As String, lngVSTOCK As Long, lngIMAGE As Long, strIMAGE As String Dim strONHAND As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH mintCnt1 = mintCnt1 + 1 ' mdteBegin = Now ' Label1 = mdteBegin strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) rc = d4top(db) lstInventory.Clear lstInventory.SortState = SortStateSuspend If rc = r4success Then ' If d4top(db) = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then With lstInventory lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN1") lngONORDER = d4field(db, "IN_ORDERTE") lngWEIGHT = d4field(db, "IN_FIELD07") lngCSQty = d4field(db, "IN_FIELD08") lngLOrder = d4field(db, "IN_LSORDR") lngLPur = d4field(db, "IN_LSPRCH") lngLSALE = d4field(db, "IN_LSSALE") lngVSTOCK = d4field(db, "IN_FIELD10") lngIMAGE = d4field(db, "IN_GRAPHIC") lngSTDCST = d4field(db, "IN_STDCST") strTYPE = f4str(lngType) strNAME = f4str(lngNAME) mstrSTOCK = UCase(Field2Str(strNAME)) strCUST = f4str(lngCUST) strVEND = f4str(lngVEND) mstrAVENDOR = Field2Str(strVEND) strVSTOCK = Trim(f4str(lngVSTOCK)) dblONHAND = f4double(lngONHAND) strONHAND = dblONHAND dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblBUYCON = f4double(lngBUYCON) dblONORDER = f4double(lngONORDER) ' If Mid$(strCUST, 1, 7) = "Dobbins" Then dblWEIGHT = f4double(lngWEIGHT) strWeight = dblWEIGHT ' End If strCSQty = f4str(lngCSQty) strLOrder = f4str(lngLOrder) strLPur = f4str(lngLPur) strLSALE = f4str(lngLSALE) strIMAGE = f4str(lngIMAGE) dblSTDCST = f4double(lngSTDCST) dblSTDCST = Format((dblSTDCST + 0.0049), "#,#.00") If Trim(strCSQty) = "0.00" Then strCSQty = "" End If If Trim(strWeight) = "0.00" Or Trim(strWeight) = "0" Then strWeight = "" End If .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) & vbTab & Trim$(strVEND) & vbTab & Trim$(strTYPE) & vbTab & (dblMIN) & vbTab & (dblMAX) & vbTab & (dblAVAIL) & vbTab & (dblLSTCOST) & vbTab & (dblRETAIL1) & vbTab & dblBUYCON & vbTab & dblONORDER & vbTab & strWeight & vbTab & strCSQty & vbTab & strLOrder & vbTab & strLPur & vbTab & strLSALE & vbTab & (strVSTOCK) & vbTab & (strIMAGE) & vbTab & (strONHAND) & vbTab & (dblSTDCST) strWeight = "" End With End If rc = d4skip(db, 1) Loop While rc = r4success End If rc = d4close(db) If lstInventory.ListCount Then lstInventory.ListIndex = 0 Else MsgBox "No Inventory Items Were Found", vbInformation + vbOKOnly, "No Inventory" End If lstInventory.SortState = SortStateActiveReSort ' mdteEnd = Now ' Label2 = mdteEnd ' If gstrLOGIN = "DWW" Then ' Label1.Visible = True ' Label2.Visible = True ' Else ' Label1.Visible = False ' Label2.Visible = False ' End If ' intMIN = DateDiff("s", mdteBegin, mdteEnd) ' lblDteBegin = Format(mdteBegin, "HH:MM:SS") ' lbldteEnd = Format(mdteEnd, "HH:MM:SS") ' lblDiff = intMIN Exit Sub Error_EH: gstrMODULE = "Form PO - Module InventoryLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub LoadInventory() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim lngBUYCON As Long, dblBUYCON As Double, lngSTDCST As Long, dblSTDCST As Double Dim lngWEIGHT As Long, dblWEIGHT As Double Dim lngONORDER As Long, dblONORDER As Double Dim lngCSQty As Long, strCSQty As String Dim intYN As Integer, strMSG As String Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long Dim strLOrder As String, strLPur As String, strLSALE As String, strTStock As String Dim strWeight As String, intMIN As Integer, strFIND As String, strTVend As String Dim strVSTOCK As String, lngVSTOCK As Long, lngIMAGE As Long, strIMAGE As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) rc = d4top(db) lstInventory.Clear lstInventory.SortState = SortStateSuspend If d4top(db) = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngCUST = d4field(db, "IN_DES") strCUST = f4str(lngCUST) If IsNull(strCUST) Or IsNull(txtSearch) Or txtSearch = "" Then intYN = 0 Else intYN = InStr(1, UCase(Trim(strCUST)), UCase(Trim(txtSearch))) ', vbTextCompare) End If If intYN > 0 Then With lstInventory lngNAME = d4field(db, "IN_STOCK") ' lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN1") lngONORDER = d4field(db, "IN_ORDERTE") lngWEIGHT = d4field(db, "IN_FIELD07") lngCSQty = d4field(db, "IN_FIELD08") lngLOrder = d4field(db, "IN_LSORDR") lngLPur = d4field(db, "IN_LSPRCH") lngLSALE = d4field(db, "IN_LSSALE") lngSTDCST = d4field(db, "IN_STDCST") lngVSTOCK = d4field(db, "IN_FIELD10") lngIMAGE = d4field(db, "IN_GRAPHIC") strTYPE = f4str(lngType) strNAME = f4str(lngNAME) ' strCUST = f4str(lngCUST) strVEND = f4str(lngVEND) strVSTOCK = Trim(f4str(lngVSTOCK)) dblONHAND = f4double(lngONHAND) dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblBUYCON = f4double(lngBUYCON) dblONORDER = f4double(lngONORDER) dblWEIGHT = f4double(lngWEIGHT) strWeight = dblWEIGHT strCSQty = f4str(lngCSQty) If Trim(strCSQty) = "0.00" Then strCSQty = "" End If strLOrder = f4str(lngLOrder) strLPur = f4str(lngLPur) strLSALE = f4str(lngLSALE) strIMAGE = f4str(lngIMAGE) dblSTDCST = f4double(lngSTDCST) dblSTDCST = Format((dblSTDCST + 0.0049), "#,#.00") If Trim(strWeight) = "0.00" Or Trim(strWeight) = "0" Then strWeight = "" End If .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) & vbTab & Trim$(strVEND) & vbTab & Trim$(strTYPE) & vbTab & (dblMIN) & vbTab & (dblMAX) & vbTab & (dblAVAIL) & vbTab & (dblLSTCOST) & vbTab & (dblRETAIL1) & vbTab & dblBUYCON & vbTab & dblONORDER & vbTab & strWeight & vbTab & strCSQty & vbTab & strLOrder & vbTab & strLPur & vbTab & strLSALE & vbTab & (strVSTOCK) & vbTab & (strIMAGE) & vbTab & (strONHAND) & vbTab & (dblSTDCST) End With End If End If rc = d4skip(db, 1) Loop While rc = r4success End If rc = d4close(db) If lstInventory.ListCount Then lstInventory.ListIndex = 0 Else strMSG = "No Inventory Items Were Found Matching The" strMSG = strMSG & vbCrLf & " Information You Entered" MsgBox strMSG, vbInformation + vbOKOnly, "Nothing Matches" End If lstInventory.SortState = SortStateActiveReSort Exit Sub Error_EH: gstrMODULE = "Form PO - Module LoadInventory" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetStock() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim oRS As Recordset, strFIND As String * 20 Dim lngPVENDOR As Long, strPVENDOR As String Dim lngBUYCON As Long, dblBUYCON As Double, lngWEIGHT As Long, dblWEIGHT As Double 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQLL = "SELECT * FROM " & mstrTABLE 'tblCPImport" Set oRS = New Recordset oRS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic mstrAVENDOR = Field2Str(oRS!VENDOR) ' Call GETALTVEND strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) Do Until oRS.EOF strFIND = Field2Str(oRS!inv_no) mstrSTOCK = UCase(Field2Str(oRS!VStock)) mstrVSTOCK = Field2Str(oRS!VStock) Call GetALIAS If mboolALIASFOUND = False Then mstrSTOCK = UCase(Field2Str(oRS!inv_no)) Call GetALIAS2 Else oRS!inv_no = Field2Str(mstrALIAS) oRS.Update End If If Not mboolALIASFOUND Then Call GETAVINFO2 strFIND = RTrim(mstrSTOCK) Else strFIND = Field2Str(mstrALIAS) End If rc = d4seek(db, strFIND) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngType = d4field(db, "IN_TYPE") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN2") lngWEIGHT = d4field(db, "IN_FIELD07") lngPVENDOR = d4field(db, "IN_VENDOR") strTYPE = f4str(lngType) strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblBUYCON = f4double(lngBUYCON) dblWEIGHT = f4double(lngWEIGHT) strPVENDOR = f4str(lngPVENDOR) End If If strNAME = strFIND Then oRS!inv_no = strNAME oRS!Description = Field2Str(strCUST) oRS!Type = Field2Str(strTYPE) oRS!LastCost = Field2Str2(dblLSTCOST) oRS!Retail1 = Field2Str2(dblRETAIL1) oRS!buycon = Field2Str2(dblBUYCON) oRS!Weight = Field2Str2(dblWEIGHT) oRS!PVendor = Field2Str(strPVENDOR) oRS.Update Else oRS!Description = "**** - " & Left(Field2Str(oRS!VDesc), 36) oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!buycon = Field2Str2(dblBUYCON) oRS!Weight = Field2Str2(dblWEIGHT) oRS!PVendor = Field2Str(strPVENDOR) oRS!Add = vbChecked oRS.Update End If oRS.MoveNext Loop 'While rc = r4success ' End If rc = d4close(db) Exit Sub Error_EH: gstrMODULE = "Form PO - Module GetStock" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetALIAS() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim oRS As Recordset, strFIND As String * 20 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = gstrCOMPANY & "INAL" db3 = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db3, "INAL_ALIAS") Call d4tagSelect(db3, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc3 = d4seek(db3, mstrSTOCK) oSTATUS = d4deleted(db3) If oSTATUS = 0 Then lngNAME = d4field(db3, "INAL_STOCK") lngCUST = d4field(db3, "INAL_ALIAS") strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) End If If mstrSTOCK = strCUST Then mstrALIAS = strNAME If mstrALIAS = " " Then mboolALIASFOUND = False Else mboolALIASFOUND = True End If Else mstrALIAS = " " mboolALIASFOUND = False End If rc3 = d4close(db3) Exit Sub Error_EH: gstrMODULE = "Form PO - Module GetALIAS" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetALIAS2() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim oRS As Recordset, strFIND As String * 20 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = gstrCOMPANY & "INAL" db3 = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db3, "INAL_ALIAS") Call d4tagSelect(db3, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc3 = d4seek(db3, mstrSTOCK) oSTATUS = d4deleted(db3) If oSTATUS = 0 Then lngNAME = d4field(db3, "INAL_STOCK") lngCUST = d4field(db3, "INAL_ALIAS") strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) End If If mstrSTOCK = strCUST Then mstrALIAS = strNAME If mstrALIAS = " " Then mboolALIASFOUND = False Else mboolALIASFOUND = True End If Else mstrALIAS = " " mboolALIASFOUND = False End If rc3 = d4close(db3) Exit Sub Error_EH: gstrMODULE = "Form PO - Module GetALIAS2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub UpdateStock() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim lngLSTCOST As Long, lngRETAIL1 As Long, dblLSTCOST As Double, dblRETAIL1 As Double Dim oRS As Recordset, strFIND As String * 20 'TAG4 pointers Dim lngCustTag As Long '************** Need to make this look up a corrected description and fix it. If the record needs to be updated, then '************** be sure to also pickup last cost On Error GoTo Error_EH strSQLL = "SELECT * FROM tblPODetail WHERE POID = " & poid & " and LineNo = " & xxxx Set oRS = New Recordset oRS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic mstrSTOCK = UCase(oRS!StockNo) strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrSTOCK) Do Until oRS.EOF strFIND = Field2Str(oRS!inv_no) rc = d4seek(db, strFIND) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngType = d4field(db, "IN_TYPE") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") strTYPE = f4str(lngType) strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) End If If strNAME = strFIND Then oRS!Description = Field2Str(strCUST) oRS!Type = Field2Str(strTYPE) oRS!LastCost = Field2Str2(dblLSTCOST) oRS!Retail1 = Field2Str2(dblRETAIL1) oRS.Update Else oRS!Description = "**** - " & Left(Field2Str(oRS!VDesc), 36) oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!Add = vbChecked oRS.Update End If oRS.MoveNext Loop 'While rc = r4success ' End If rc = d4close(db) Exit Sub Error_EH: gstrMODULE = "Form PO - Module UpdateStock" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectAllLoad() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim strSELECT As String Dim oRS As Recordset 'TAG4 pointers Dim lngCustTag As Long ' On Error GoTo Error_EH On Error Resume Next aTabs(0) = 100 aTabs(1) = 120 aTabs(2) = 200 strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngRET = SendMessage(lstInventory.hwnd, LB_SETTABSTOPS, 3, aTabs(0)) ' strSQLL = cboARCode.Text rc = d4top(db) ' lstInventory.Clear lstInventory.SortState = SortStateSuspend If d4top(db) = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then ' lngRECORD = d4field(db, "AR_CODE") ' strCode = f4str(lngRECORD) ' If strCode = strSQLL Then With oRS .AddNew lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") ' strTYPE = f4str(lngTYPE) ' strNAME = f4str(lngNAME) ' strCUST = f4str(lngCUST) !inv_no = f4str(lngNAME) !Description = f4str(lngCUST) !VENDOR = f4str(lngVEND) !Type = f4str(lngType) !OnHand = f4double(lngONHAND) !User = gstrLOGIN .Update ' .AddItem RTrim$(strNAME) & vbTab & Trim$(strCUST) End With ' End If End If rc = d4skip(db, 1) Loop While rc = r4success End If rc = d4close(db) oRS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module SelectAllLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectPartialLoad() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim lngLSTCOST As Long, lngRETAIL1 As Long Dim dblLSTCOST As String, dblRETAIL1 As String Dim strVEND As String, strTYPE As String, strINVNO As String, strDESC As String * 45 Dim strSELECT As String, strBEG As String * 45, strEND As String * 45 Dim oRS As Recordset Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim dblOrder As Double, dblCost As Double, dblALLTOTAL As Double Dim lngBUYCON As Long, dblBUYCON As Double, intREM As Integer, intWHOLE As Integer Dim lngONORDER As Long, dblONORDER As Double Dim strBEG2 As String, strEND2 As String Dim lngWEIGHT As Long, dblWEIGHT As Double Dim strLOrder As String, strLPur As String, strLSALE As String Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long Dim strONHAND As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH On Error Resume Next mlngCOUNT = 0 strBEG = txtBegSelect strEND = txtEndSelect strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) rc = d4top(db) lstInventory.SortState = SortStateSuspend If d4top(db) = r4success Then '1 Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then '2 mlngCOUNT = mlngCOUNT + 1 dblMIN = 0 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 dblALLTOTAL = 0 dblONORDER = 0 dblLSTCOST = 0 dblRETAIL1 = 0 dblCost = 0 lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN1") lngONORDER = d4field(db, "IN_ORDERTE") lngWEIGHT = d4field(db, "IN_FIELD07") lngLOrder = d4field(db, "IN_LSORDR") lngLPur = d4field(db, "IN_LSPRCH") lngLSALE = d4field(db, "IN_LSSALE") dblWEIGHT = f4double(lngWEIGHT) strINVNO = Trim(f4str(lngNAME)) strDESC = Trim(f4str(lngCUST)) strVEND = Trim(f4str(lngVEND)) strTYPE = Trim(f4str(lngType)) dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblONHAND = f4double(lngONHAND) strONHAND = dblONHAND dblONORDER = f4double(lngONORDER) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblALLTOTAL = dblONORDER + dblAVAIL dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblCost = f4double(lngLSTCOST) dblBUYCON = f4double(lngBUYCON) strLOrder = f4str(lngLOrder) strLPur = f4str(lngLPur) strLSALE = f4str(lngLSALE) ' If dblMAX > 0 And Not chkZero Then ' If dblMAX > 0 And chkZero Then If dblMAX > 0 Then '3 If cboSort.ListIndex = 0 Then '4 If Trim$(strINVNO) >= Trim$(strBEG) And Trim$(strINVNO) <= Trim$(strEND) Then '5 If dblALLTOTAL <= dblMIN Then ' 6 dblOrder = dblMAX - dblALLTOTAL '**************** intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then '7 intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If '7 If dblOrder > 0 Or mboolALL Then '7 With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str2(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With End If '7 End If '6 End If '5 ' End If ' End If ' If dblMAX > 0 And Not chkZero Then ElseIf cboSort.ListIndex = 1 Then '4 If UCase(strDESC) >= UCase(strBEG) And UCase(strDESC) <= UCase(strEND) Then '5 If dblALLTOTAL <= dblMIN Then '6 dblOrder = dblMAX - dblALLTOTAL intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then '7 intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If '7 If dblOrder > 0 Or mboolALL Then '7 With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !Cost = dblLSTCOST !User = gstrLOGIN .Update End With End If '7 End If '6 End If '5 ' End If THIS MAY NOT BE CORRECT ' End If ' If dblMAX > 0 And Not chkZero Then ElseIf cboSort.ListIndex = 2 Then '4 ' If Not chkZero And dblOrder > 0 Then strBEG2 = Trim$(strBEG) strEND2 = Trim$(strEND) If Trim$(strVEND) >= Trim$(strBEG2) And Trim$(strVEND) <= Trim$(strEND2) Then '5 ' If dblALLTOTAL <= dblMIN Then If chkZero = vbUnchecked Then '6 ' If dblALLTOTAL <= dblMIN Then '6 dblOrder = dblMAX - dblALLTOTAL If dblBUYCON <> 0 Then '7 intREM = dblOrder Mod dblBUYCON End If '7 If dblBUYCON > 1 And intREM > 0 Then '7 intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If '7 If dblOrder < 0 Then dblOrder = 0 End If ' If Not chkZero Then '7 ' If Not chkZero And dblOrder > 0 Then With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With End If '6 ' If chkZero Then If chkZero = vbChecked And dblALLTOTAL <= dblMIN Then '6 dblOrder = dblMAX - dblALLTOTAL If dblBUYCON <> 0 Then '7 intREM = dblOrder Mod dblBUYCON End If '7 If dblBUYCON > 1 And intREM > 0 Then '7 intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If '7 If dblOrder > 0 Then '7 With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With End If '7 End If '6 ' End If End If '5 ' End If ' If dblMAX > 0 And Not chkZero Then ElseIf cboSort.ListIndex = 3 Then '4 If Trim$(strTYPE) >= Trim$(strBEG) And Trim$(strTYPE) <= Trim$(strEND) Then '5 If dblALLTOTAL <= dblMIN Then '6 dblOrder = dblMAX - dblALLTOTAL intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then '7 intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If '7 If dblOrder > 0 Or mboolALL Then '7 With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !Weight = dblWEIGHT !User = gstrLOGIN .Update End With End If '7 End If '6 End If '5 End If '4 End If '3 End If '2 rc = d4skip(db, 1) Loop While rc = r4success ' End If '2 End If '1 rc = d4close(db) oRS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load mlngCOUNT = mlngCOUNT On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module SelectPartialLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectPartialLoadHold() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim lngLSTCOST As Long, lngRETAIL1 As Long Dim dblLSTCOST As String, dblRETAIL1 As String Dim strVEND As String, strTYPE As String, strINVNO As String, strDESC As String * 45 Dim strSELECT As String, strBEG As String * 45, strEND As String * 45 Dim oRS As Recordset Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim dblOrder As Double, dblCost As Double, dblALLTOTAL As Double Dim lngBUYCON As Long, dblBUYCON As Double, intREM As Integer, intWHOLE As Integer Dim lngONORDER As Long, dblONORDER As Double Dim strBEG2 As String, strEND2 As String Dim lngWEIGHT As Long, dblWEIGHT As Double Dim strLOrder As String, strLPur As String, strLSALE As String Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long Dim strONHAND As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH On Error Resume Next mlngCOUNT = 0 strBEG = txtBegSelect strEND = txtEndSelect strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) rc = d4top(db) lstInventory.SortState = SortStateSuspend If d4top(db) = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then mlngCOUNT = mlngCOUNT + 1 dblMIN = 0 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 dblALLTOTAL = 0 dblONORDER = 0 dblLSTCOST = 0 dblRETAIL1 = 0 dblCost = 0 lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN1") lngONORDER = d4field(db, "IN_ORDERTE") lngWEIGHT = d4field(db, "IN_FIELD07") lngLOrder = d4field(db, "IN_LSORDR") lngLPur = d4field(db, "IN_LSPRCH") lngLSALE = d4field(db, "IN_LSSALE") dblWEIGHT = f4double(lngWEIGHT) strINVNO = Trim(f4str(lngNAME)) strDESC = Trim(f4str(lngCUST)) strVEND = Trim(f4str(lngVEND)) strTYPE = Trim(f4str(lngType)) dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblONHAND = f4double(lngONHAND) strONHAND = dblONHAND dblONORDER = f4double(lngONORDER) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblALLTOTAL = dblONORDER + dblAVAIL dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblCost = f4double(lngLSTCOST) dblBUYCON = f4double(lngBUYCON) strLOrder = f4str(lngLOrder) strLPur = f4str(lngLPur) strLSALE = f4str(lngLSALE) If dblMAX > 0 And Not chkZero Then If cboSort.ListIndex = 0 Then If Trim$(strINVNO) >= Trim$(strBEG) And Trim$(strINVNO) <= Trim$(strEND) Then If dblALLTOTAL <= dblMIN Then dblOrder = dblMAX - dblALLTOTAL '**************** intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If If dblOrder > 0 Or mboolALL Then With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str2(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With End If End If End If End If End If If dblMAX > 0 And Not chkZero Then If cboSort.ListIndex = 1 Then If UCase(strDESC) >= UCase(strBEG) And UCase(strDESC) <= UCase(strEND) Then If dblALLTOTAL <= dblMIN Then dblOrder = dblMAX - dblALLTOTAL intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If If dblOrder > 0 Or mboolALL Then With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !Cost = dblLSTCOST !User = gstrLOGIN .Update End With End If End If End If End If End If If dblMAX > 0 And Not chkZero Then If cboSort.ListIndex = 2 Then strBEG2 = Trim$(strBEG) strEND2 = Trim$(strEND) If Trim$(strVEND) >= Trim$(strBEG2) And Trim$(strVEND) <= Trim$(strEND2) Then If dblALLTOTAL <= dblMIN Then dblOrder = dblMAX - dblALLTOTAL If dblBUYCON <> 0 Then intREM = dblOrder Mod dblBUYCON End If If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With End If End If End If End If If dblMAX > 0 And Not chkZero Then If cboSort.ListIndex = 3 Then If Trim$(strTYPE) >= Trim$(strBEG) And Trim$(strTYPE) <= Trim$(strEND) Then If dblALLTOTAL <= dblMIN Then dblOrder = dblMAX - dblALLTOTAL intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON End If If dblOrder > 0 Or mboolALL Then With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !OnOrder = dblONORDER !Available = dblALLTOTAL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !Weight = dblWEIGHT !User = gstrLOGIN .Update End With End If End If End If End If End If End If rc = d4skip(db, 1) Loop While rc = r4success End If rc = d4close(db) oRS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load mlngCOUNT = mlngCOUNT On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module SelectPartialLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSearch_Click() 'Multiple character search code. lstInventory.SearchText = txtSearch.Text lstInventory.SearchMethod = 2 lstInventory.SearchIndex = -1 lstInventory.Action = 0 If lstInventory.SearchIndex <> -1 Then lstInventory.TopIndex = lstInventory.SearchIndex lstInventory.ListIndex = lstInventory.SearchIndex Else lstInventory.Action = 6 ' clear End If End Sub Private Sub cboSort_Click() Dim intMIN As Integer On Error Resume Next mintCnt2 = mintCnt2 + 1 lblCount2 = mintCnt2 mdteBegin = Now ' cboSortOrder.ListIndex = cboSort.ListIndex cboSortOrder.ListIndex = 4 If cboSort.ListIndex = 0 Then ' If mbytSort <> cbolistindex Then If mbytSort = 4 Then Call InventoryLoad End If lstInventory.col = 1 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 3 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 2 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 16 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 0 lstInventory.ColSortSeq = 0 lstInventory.ColSorted = SortedAscending lstInventory.Redraw = True lstInventory.ColSortDataType = ColSortDataTypeTextNoCase lstInventory.SearchIgnoreCase = True lstInventory.ColumnSearch = 0 lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 0 If chkKEEP Then Call cmdSearch_Click txtSearch.SetFocus Else txtSearch = "" txtSearch.SetFocus End If lblSearch.Caption = "Enter Stock # Search Information:" ElseIf cboSort.ListIndex = 1 Then If mbytSort = 4 Then Call InventoryLoad End If lstInventory.col = 0 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 2 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 3 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 16 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 1 lstInventory.ColSortSeq = 0 lstInventory.ColSorted = SortedAscending lstInventory.Redraw = True lstInventory.ColSortDataType = ColSortDataTypeTextNoCase lstInventory.SearchIgnoreCase = True lstInventory.ColumnSearch = 1 lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 1 If chkKEEP Then Call cmdSearch_Click txtSearch.SetFocus Else txtSearch = "" txtSearch.SetFocus End If ' txtSearch = "" lblSearch.Caption = "Enter Description Search Information:" ' txtSearch.SetFocus ElseIf cboSort.ListIndex = 2 Then If mbytSort = 4 Then Call InventoryLoad End If lstInventory.col = 0 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 3 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 1 lstInventory.ColSortSeq = 1 ' lstInventory.ColSortSeq = -1 ' lstInventory.ColSorted = SortedNone lstInventory.ColSorted = SortedAscending lstInventory.col = 16 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 2 lstInventory.ColSortSeq = 0 lstInventory.ColSorted = SortedAscending lstInventory.Redraw = True lstInventory.ColSortDataType = ColSortDataTypeTextNoCase lstInventory.SearchIgnoreCase = True lstInventory.ColumnSearch = 2 lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 2 If chkKEEP Then Call cmdSearch_Click txtSearch.SetFocus Else txtSearch = "" txtSearch.SetFocus End If lblSearch.Caption = "Enter Vendor Search Information:" ' txtSearch.SetFocus ElseIf cboSort.ListIndex = 3 Then If mbytSort = 4 Then Call InventoryLoad End If lstInventory.col = 0 lstInventory.ColSortSeq = 1 ' lstInventory.ColSortSeq = -1 ' lstInventory.ColSorted = SortedNone lstInventory.ColSorted = SortedAscending lstInventory.col = 1 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 2 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 16 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 3 lstInventory.ColSortSeq = 0 lstInventory.ColSorted = SortedAscending lstInventory.Redraw = True lstInventory.ColSortDataType = ColSortDataTypeTextNoCase lstInventory.SearchIgnoreCase = True lstInventory.ColumnSearch = 3 lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 3 If chkKEEP Then Call cmdSearch_Click txtSearch.SetFocus Else txtSearch = "" txtSearch.SetFocus End If lblSearch.Caption = "Enter Product Type Search Information:" ElseIf cboSort.ListIndex = 5 Then If mbytSort = 4 Then Call InventoryLoad End If lstInventory.col = 0 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 2 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 3 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 1 lstInventory.ColSortSeq = -1 lstInventory.ColSorted = SortedNone lstInventory.col = 16 lstInventory.ColSortSeq = 0 lstInventory.ColSorted = SortedAscending lstInventory.Redraw = True lstInventory.ColSortDataType = ColSortDataTypeTextNoCase lstInventory.SearchIgnoreCase = True lstInventory.ColumnSearch = 16 lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 1 If chkKEEP Then Call cmdSearch_Click txtSearch.SetFocus Else txtSearch = "" txtSearch.SetFocus End If ' txtSearch = "" lblSearch.Caption = "Enter Vendor Stock Search Information:" ' txtSearch.SetFocus ElseIf cboSort.ListIndex = 4 Then Call LoadInventory ' txtSearch.SetFocus End If mbytSort = cboSort.ListIndex ' mdteEnd = Now ' intMIN = DateDiff("s", mdteBegin, mdteEnd) ' lblDteBegin = Format(mdteBegin, "HH:MM:SS") ' lbldteEnd = Format(mdteEnd, "HH:MM:SS") ' lblDiff = intMIN End Sub Private Sub cboSortOrder_Click() On Error Resume Next If cboSortOrder.ListIndex = 0 Then lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 8 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 0 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 0 ElseIf cboSortOrder.ListIndex = 1 Then lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 1 ElseIf cboSortOrder.ListIndex = 2 Then lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 2 txtSearch = "" lblSearch.Caption = "Enter Vendor Search Information:" txtSearch.SetFocus ElseIf cboSortOrder.ListIndex = 3 Then lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeTextNoCase lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 3 ElseIf cboSortOrder.ListIndex = 4 Then lstProcess.col = 0 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 1 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 2 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 3 lstProcess.ColSortSeq = -1 lstProcess.ColSorted = SortedNone lstProcess.col = 9 lstProcess.ColSortSeq = 0 lstProcess.ColSorted = SortedAscending lstProcess.Redraw = True lstProcess.ColSortDataType = ColSortDataTypeInteger lstProcess.SearchIgnoreCase = True lstProcess.ColumnSearch = 3 End If End Sub 'Private Sub cmdCalc_Click() ' Screen.MousePointer = vbHourglass ' If lblBegDate2.caption = "" Then ' MsgBox "No Dates Set, No Calculations Will Process", vbOKOnly, "No Calculation" ' Exit Sub ' End If ' lblMessage.Visible = True ' lblMessage.caption = "Calculating -- Be Patient" ' DoEvents ' Call InvProcess ' lblMessage.Visible = False ' MsgBox "Calculation Complete", vbOKOnly, "Done" ' Screen.MousePointer = vbDefault 'End Sub Private Sub cmdClear_Click() Dim strSQL As String ' strSQL = "UPDATE tblPOList SET User = 'XX'" ' WHERE User = '" & gstrLOGIN & "'" strSQL = "Delete * FROM tblPOList WHERE User = '" & gstrLOGIN & "'" goConn.Execute strSQL ' strSQL = "DELETE * FROM tblINVUsage" ' goConn.Execute strSQL Call ClearMiddle Call Inventory2Load chkOKPO = vbUnchecked If chkOKPO Then mnuCreate2.Enabled = False Else mnuCreate2.Enabled = True End If End Sub Private Sub ClearMiddle() lblMessage = "" lblMessage.Visible = False lblTest = "" lblStock = "" lblShowDesc = "" txtOrderQty = 0 lstCompare.Clear End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdPartial_Click() lblMessage.Caption = "Selecting Items Using Seletion Criteria - Be PATIENT" lblMessage.Visible = True DoEvents Call SelectPartialLoad lblMessage.Visible = False End Sub Private Sub cmdReports_Click() frmRepList.Show 1 End Sub Private Sub cmdSetEnd_Click() Dim oRS As Recordset Dim strSQL As String, strSQL2 As String Dim strINVNO As String, strDESC As String, strVEND As String Dim strTYPE As String, dblONHAND As Double On Error Resume Next lstInventory.col = 0 strINVNO = lstInventory.ColText lstInventory.col = 1 strDESC = lstInventory.ColText lstInventory.col = 2 strVEND = lstInventory.ColText lstInventory.col = 3 strTYPE = lstInventory.ColText lstInventory.col = 4 dblONHAND = lstInventory.ColText If cboSort.ListIndex = 0 Then txtEndSelect = strINVNO ElseIf cboSort.ListIndex = 1 Then txtEndSelect = strDESC ElseIf cboSort.ListIndex = 2 Then txtEndSelect = strVEND ElseIf cboSort.ListIndex = 3 Then txtEndSelect = strTYPE End If Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdSetEnd_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSetBeg_Click() Dim oRS As Recordset Dim strSQL As String, strSQL2 As String Dim strINVNO As String, strDESC As String, strVEND As String Dim strTYPE As String, dblONHAND As Double On Error Resume Next lstInventory.col = 0 strINVNO = lstInventory.ColText lstInventory.col = 1 strDESC = lstInventory.ColText lstInventory.col = 2 strVEND = lstInventory.ColText lstInventory.col = 3 strTYPE = lstInventory.ColText lstInventory.col = 4 dblONHAND = lstInventory.ColText If cboSort.ListIndex = 0 Then txtBegSelect = strINVNO txtEndSelect = strINVNO ElseIf cboSort.ListIndex = 1 Then txtBegSelect = strDESC txtEndSelect = strDESC ElseIf cboSort.ListIndex = 2 Then txtBegSelect = strVEND txtEndSelect = strVEND ElseIf cboSort.ListIndex = 3 Then txtBegSelect = strTYPE txtEndSelect = strTYPE End If Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdSetBeg_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdFixDesc_Click() Dim ARCode As Long, oSTATUS As Long, lngDESC As Long Dim strSQL As String, strFILE As String 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH mstrSTOCK = "" mstrDESC = "" mintBOOKMARK = lstInventory.ListIndex lstInventory.col = 0 mstrSTOCK = lstInventory.ColText lstInventory.col = 1 strDESC = lstInventory.ColText ' cdPO.CancelError = True mstrDESC = InputBox("Enter The Updated Description (45 Char Max)", "New Description", strDESC) If mstrDESC = "" Then MsgBox "Description Was Not Changed", vbInformation + vbOKOnly, "No Change" Exit Sub Else mstrDESC = Mid(mstrDESC, 1, 45) End If strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) ' cboAlias.Clear If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngDESC = d4field(db4, "IN_DES") strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngDESC, mstrDESC) ' rc = d4append(db) rc4 = d4flush(db4) End If ' rc = d4seekNext(db, mstrCUSTOMER2) End If ' Loop rc4 = d4close(db4) '******** Update INMAT File strFILE = gstrCOMPANY & "INMAT.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "INMXSTOCK3") ' lngInvTag = d4tag(db4, "INMXSTOCK") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) ' cboAlias.Clear If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngDESC = d4field(db4, "INMXDES") strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngDESC, mstrDESC) ' rc = d4append(db) rc4 = d4flush(db4) End If ' rc = d4seekNext(db, mstrCUSTOMER2) End If ' Loop rc4 = d4close(db4) Call F5On ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdFixDesc_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cboVendor_KeyPress(KeyAscii As Integer) Dim strControl As String strControl = Me.ActiveControl.Name If KeyAscii = 13 Then KeyCode = vbTab KeyAscii = 0 cboVendor.SetFocus cboVendor.col = 1 gstrVENDOR = cboVendor.ColText Call mnuCreate_Click End If If strControl = "cboVendor" Then If KeyAscii = 27 Then KeyAscii = 0 lblSelectVend.Visible = False cboVendor.Visible = False lblBegSelect.Visible = True lblEndSelect.Visible = True txtEndSelect.Visible = True txtBegSelect.Visible = True txtBegDate.Visible = True txtEndDate.Visible = True lblBegDate.Visible = True lblEndDate.Visible = True End If End If End Sub Private Sub cmdAlias_Click() If gbytSECURITY = 2 Then MsgBox "You Should Not Be Changing Alias Information - Get A Manager Or See Darv", vbOKOnly, "UnAuthorized" Exit Sub End If frmAlias.Show 1 End Sub Private Sub cmdAltVend2_Click() Dim strVENDOR As String * 20, strVSTOCK As String * 20, strAVKEY As String * 80 gboolALTVEND = True strVSTOCK = InputBox("Enter the Vendor STOCK NUMBER to Find", "Vendor Stock #") strVSTOCK = UCase(strVSTOCK) If Trim(strVSTOCK) = "" Then MsgBox "You Must Enter A Vendor Stock Number", vbCritical + vbOKOnly, "Error" Exit Sub End If gstrSTOCK = strVSTOCK frmVendAlt2.Show 1 gstrSTOCK = "" Call Inventory2Load End Sub Private Sub cmdAltVendor_Click() Dim strVENDOR As String * 20, strVSTOCK As String * 20, strAVKEY As String * 80 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngVSTOCK As Long Dim lngSTOCK As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strSTOCK As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim lngONHAND As Long, dblONHAND As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH strVENDOR = InputBox("Enter The Vendor NUMBER for the Vendor Stock Number", "Vendor Number") strVENDOR = UCase(strVENDOR) If Trim(strVENDOR) = "" Then MsgBox "You Must Enter A Vendor Number", vbCritical + vbOKOnly, "Error" Exit Sub End If strVSTOCK = InputBox("Enter the Vendor STOCK NUMBER to Find", "Vendor Stock #") strVSTOCK = UCase(strVSTOCK) If Trim(strVSTOCK) = "" Then MsgBox "You Must Enter A Vendor Stock Number", vbCritical + vbOKOnly, "Error" Exit Sub End If cb = code4init strSQL = gstrCOMPANY & "INAV" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INAVVSTOCK") ' mstrAVENDOR = "LEX500 " mstrSTOCK2 = strVSTOCK + strVENDOR ' mstrSTOCK2 = mstrSTOCK + "LEX500 " Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrSTOCK2) oSTATUS = d4deleted(db) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngSTOCK = d4field(db, "INAVVSTOCK") strSTOCK = f4str(lngSTOCK) If Trim(strSTOCK) = Trim(strVSTOCK) Then lngVEND = d4field(db, "INAVVENDOR") lngVSTOCK = d4field(db, "INAVSTOCK") strVEND = f4str(lngVEND) If Trim(strVEND) = Trim(strVENDOR) Then mstrNSTOCK = f4str(lngVSTOCK) cboSort.ListIndex = 0 txtSearch = Trim(mstrNSTOCK) Else MsgBox "No Vendor Stock Number " & Trim(strVSTOCK) & " Found", vbCritical + vbOKOnly, "No Vendor Stock #" Exit Sub End If Else MsgBox "No Vendor Stock Number " & Trim(strVSTOCK) & " Found", vbCritical + vbOKOnly, "No Vendor Stock #" Exit Sub End If End If rc = d4close(db) Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdAltVendor_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAPAR_Click() frmAPAR.Show 1 End Sub Private Sub cmdImpCMS_Click() frmPOImp.Show End Sub Private Sub cmdMinMax_Click() Dim dblMIN As Double, dblMAX As Double, strTYPE As String Dim strSTOCK As String, lngType As Long, lngGLKEY As Long Dim ARCode As Long, oSTATUS As Long Dim strMIN As String, strMAX As String, strTType As String Dim lngMIN As Long, lngMAX As Long, lngCATNBR As Long, lngUDF01 As Long Dim strSQL As String, strFILE As String, strCATNBR As String, strUDF01 As String 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH lstInventory.col = 0 strSTOCK = lstInventory.ColText lstInventory.col = 3 strTYPE = lstInventory.ColText lstInventory.col = 4 dblMIN = Field2Str2(lstInventory.ColText) lstInventory.col = 5 dblMAX = Field2Str2(lstInventory.ColText) ' dblMIN = InputBox("Enter the Corrected MIN Amount", "Correct MIN", dblMIN) strMIN = InputBox("Enter the Corrected MIN Amount", "Correct MIN", dblMIN) If strMIN = "" Then MsgBox "MIN Not Updated", vbOKOnly, "Not Updated" Exit Sub End If If Not IsNumeric(strMIN) Then MsgBox "Must Be A Number - ReEnter", vbOKOnly, "ReEnter a Number" Exit Sub Else dblMIN = Field2Str2(strMIN) End If ' dblMAX = InputBox("Enter the Corrected MAX Amount", "Correct MAX", dblMAX) strMAX = InputBox("Enter the Corrected MAX Amount", "Correct MAX", dblMAX) If strMAX = "" Then MsgBox "MAX Not Updated", vbOKOnly, "Not Updated" Exit Sub End If If Not IsNumeric(strMAX) Then MsgBox "Must Be A Number - ReEnter", vbOKOnly, "ReEnter a Number" Exit Sub Else dblMAX = Field2Str2(strMAX) End If strCATNBR = "M" strUDF01 = "N" strTType = InputBox("Enter The New Type if Desired", "Type", strTYPE) If strTType = "" Then MsgBox "TYPE Not Updated", vbOKOnly, "Not Updated" Exit Sub End If strTYPE = strTType mintBOOKMARK = lstInventory.ListIndex strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) rc4 = d4seek(db4, strSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngMIN = d4field(db4, "IN_MINQTY") lngMAX = d4field(db4, "IN_MAXQTY") lngCATNBR = d4field(db4, "IN_CATNBR") lngUDF01 = d4field(db4, "IN_FIELD01") lngType = d4field(db4, "IN_TYPE") lngGLKEY = d4field(db4, "IN_GLKEY") Call f4assignDouble(lngMIN, dblMIN) Call f4assignDouble(lngMAX, dblMAX) Call f4assign(lngCATNBR, strCATNBR) Call f4assign(lngUDF01, strUDF01) Call f4assign(lngType, strTYPE) Call f4assign(lngGLKEY, strTYPE) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) strFILE = gstrCOMPANY & "INMAT.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "INMXSTOCK3") ' lngInvTag = d4tag(db4, "INMXSTOCK") Call d4tagSelect(db4, lngInvTag) rc4 = d4seek(db4, strSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngType = d4field(db4, "INMXTYPE") Call f4assign(lngType, strTYPE) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) Call F5On ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdMinMax" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdMinMax2_Click() Dim dblMIN As Double, dblMAX As Double, strTYPE As String Dim strSTOCK As String, lngType As Long, lngGLKEY As Long Dim ARCode As Long, oSTATUS As Long Dim lngMIN As Long, lngMAX As Long, lngCATNBR As Long, lngUDF01 As Long Dim strSQL As String, strFILE As String, strCATNBR As String, strUDF01 As String Dim intBookmark As Integer 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH lstProcess.col = 0 strSTOCK = lstProcess.ColText ' lstProcess.Col = 3 ' strTYPE = lstProcess.ColText lstProcess.col = 4 dblMIN = Field2Str2(lstProcess.ColText) lstProcess.col = 5 dblMAX = Field2Str2(lstProcess.ColText) dblMIN = InputBox("Enter the Corrected MIN Amount", "Correct MIN", dblMIN) dblMAX = InputBox("Enter the Corrected MAX Amount", "Correct MAX", dblMAX) ' strCATNBR = InputBox("Enter The Order Frequency (WMBS)", "Order Frequency", "M") ' strUDF01 = InputBox("Enter Y to Calculate MIN/MAX", "Calc MIN/MAX", "Y") ' strCATNBR = "M" ' strUDF01 = "N" ' strTYPE = InputBox("Enter The New Type if Desired", "Type", strTYPE) mintBOOKMARK = lstInventory.ListIndex intBookmark = lstProcess.ListIndex strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) rc4 = d4seek(db4, strSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngMIN = d4field(db4, "IN_MINQTY") lngMAX = d4field(db4, "IN_MAXQTY") ' lngCATNBR = d4field(db4, "IN_CATNBR") ' lngUDF01 = d4field(db4, "IN_FIELD01") ' lngTYPE = d4field(db4, "IN_TYPE") ' lngGLKEY = d4field(db4, "IN_GLKEY") Call f4assignDouble(lngMIN, dblMIN) Call f4assignDouble(lngMAX, dblMAX) ' Call f4assign(lngCATNBR, strCATNBR) ' Call f4assign(lngUDF01, strUDF01) ' Call f4assign(lngTYPE, strTYPE) ' Call f4assign(lngGLKEY, strTYPE) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) ' strFILE = gstrCOMPANY & "INMAT.DBF" ' db4 = d4open(cb, fPath + strFILE) ' lngInvTag = d4tag(db4, "INMXSTOCK") ' Call d4tagSelect(db4, lngInvTag) ' rc4 = d4seek(db4, strSTOCK) ' If rc4 = r4success Then ' oSTATUS = d4deleted(db4) ' If oSTATUS = 0 Then ' lngMIN = d4field(db4, "IN_MINQTY") ' lngMAX = d4field(db4, "IN_MAXQTY") ' lngCATNBR = d4field(db4, "IN_CATNBR") ' lngUDF01 = d4field(db4, "IN_FIELD01") '' lngTYPE = d4field(db4, "INMXTYPE") ' lngGLKEY = d4field(db4, "IN_GLKEY") ' Call f4assignDouble(lngMIN, dblMIN) ' Call f4assignDouble(lngMAX, dblMAX) ' Call f4assign(lngCATNBR, strCATNBR) ' Call f4assign(lngUDF01, strUDF01) '' Call f4assign(lngTYPE, strTYPE) ' Call f4assign(lngGLKEY, strTYPE) '' rc4 = d4flush(db4) ' lngVENDOR = d4field(db4, "INMXVENDOR") ' strDESC = Trim$(Field2Str(txtDescription)) ' Call f4assign(lngVENDOR, gstrVENDOR) ' rc = d4append(db) ' rc4 = d4flush(db4) ' End If ' rc = d4seekNext(db, mstrCUSTOMER2) ' End If ' Loop ' rc4 = d4close(db4) moRSUpdate!Min = dblMIN moRSUpdate!Max = dblMAX moRSUpdate.Update lblWait.Visible = True DoEvents ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK Call Inventory2Load lstProcess.ListIndex = intBookmark lblWait.Visible = False DoEvents Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdMinMax2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdType2_Click() Dim dblMIN As Double, dblMAX As Double, strTYPE As String Dim strSTOCK As String, lngType As Long, lngGLKEY As Long Dim ARCode As Long, oSTATUS As Long Dim lngMIN As Long, lngMAX As Long, lngCATNBR As Long, lngUDF01 As Long Dim strSQL As String, strFILE As String, strCATNBR As String, strUDF01 As String Dim intBookmark As Integer 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH lstProcess.col = 0 strSTOCK = lstProcess.ColText ' lstProcess.Col = 3 ' strTYPE = lstProcess.ColText lstProcess.col = 4 dblMIN = Field2Str2(lstProcess.ColText) lstProcess.col = 5 dblMAX = Field2Str2(lstProcess.ColText) dblMIN = InputBox("Enter the Corrected MIN Amount", "Correct MIN", dblMIN) dblMAX = InputBox("Enter the Corrected MAX Amount", "Correct MAX", dblMAX) ' strCATNBR = InputBox("Enter The Order Frequency (WMBS)", "Order Frequency", "M") ' strUDF01 = InputBox("Enter Y to Calculate MIN/MAX", "Calc MIN/MAX", "Y") ' strCATNBR = "M" ' strUDF01 = "N" ' strTYPE = InputBox("Enter The New Type if Desired", "Type", strTYPE) mintBOOKMARK = lstInventory.ListIndex intBookmark = lstProcess.ListIndex strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) rc4 = d4seek(db4, strSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngMIN = d4field(db4, "IN_MINQTY") lngMAX = d4field(db4, "IN_MAXQTY") ' lngCATNBR = d4field(db4, "IN_CATNBR") ' lngUDF01 = d4field(db4, "IN_FIELD01") ' lngTYPE = d4field(db4, "IN_TYPE") ' lngGLKEY = d4field(db4, "IN_GLKEY") Call f4assignDouble(lngMIN, dblMIN) Call f4assignDouble(lngMAX, dblMAX) ' Call f4assign(lngCATNBR, strCATNBR) ' Call f4assign(lngUDF01, strUDF01) ' Call f4assign(lngTYPE, strTYPE) ' Call f4assign(lngGLKEY, strTYPE) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) ' strFILE = gstrCOMPANY & "INMAT.DBF" ' db4 = d4open(cb, fPath + strFILE) ' lngInvTag = d4tag(db4, "INMXSTOCK") ' Call d4tagSelect(db4, lngInvTag) ' rc4 = d4seek(db4, strSTOCK) ' If rc4 = r4success Then ' oSTATUS = d4deleted(db4) ' If oSTATUS = 0 Then ' lngMIN = d4field(db4, "IN_MINQTY") ' lngMAX = d4field(db4, "IN_MAXQTY") ' lngCATNBR = d4field(db4, "IN_CATNBR") ' lngUDF01 = d4field(db4, "IN_FIELD01") '' lngTYPE = d4field(db4, "INMXTYPE") ' lngGLKEY = d4field(db4, "IN_GLKEY") ' Call f4assignDouble(lngMIN, dblMIN) ' Call f4assignDouble(lngMAX, dblMAX) ' Call f4assign(lngCATNBR, strCATNBR) ' Call f4assign(lngUDF01, strUDF01) '' Call f4assign(lngTYPE, strTYPE) ' Call f4assign(lngGLKEY, strTYPE) '' rc4 = d4flush(db4) ' lngVENDOR = d4field(db4, "INMXVENDOR") ' strDESC = Trim$(Field2Str(txtDescription)) ' Call f4assign(lngVENDOR, gstrVENDOR) ' rc = d4append(db) ' rc4 = d4flush(db4) ' End If ' rc = d4seekNext(db, mstrCUSTOMER2) ' End If ' Loop ' rc4 = d4close(db4) moRSUpdate!Min = dblMIN moRSUpdate!Max = dblMAX moRSUpdate.Update lblWait.Visible = True DoEvents ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK Call Inventory2Load lstProcess.ListIndex = intBookmark lblWait.Visible = False DoEvents Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdType2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdOnOrder_Click() lstInventory.col = 0 gstrONORDER = lstInventory.ColText lstInventory.col = 1 gstrDESC = lstInventory.ColText lstInventory.col = 2 gstrVENDOR = lstInventory.ColText frmOnOrder.Show 1 End Sub Private Sub cmdOpenPO_Click() ' chkNoDisplay = vbUnchecked frmPOOpen.Show 1 ' chkOKPO = vbUnchecked If chkOKPO Then mnuCreate2.Enabled = False Else mnuCreate2.Enabled = True End If Call Inventory2Load ' chkNoDisplay = vbChecked lstProcess.ListIndex = 0 End Sub Private Sub cmdTest_Click() frmInvAdd2.Show 1 End Sub Private Sub cmdSunburst_Click() Dim xlInvoice As Excel.Application Dim strSBFile As String ' cdPO.InitDir = "e:\Invoices" cdPO.DefaultExt = ".xls" cdPO.InitDir = "c:\projects\historysum" cdPO.Action = 1 strSBFile = cdPO.FileName Set xlInvoice = Excel.Workbooks.Item(strSBFile) End Sub Private Sub cmdPrint_Click() Dim intYN As Integer, intYN2 As Integer, strFILE As String Dim intYN3 As Integer, strMSG As String, intYN4 As Integer, intYN5 As Integer Dim intYN6 As Integer On Error GoTo Error_EH intYN3 = 0 intYN = 0 intYN2 = 0 intYN4 = 0 intYN5 = 0 ' cdPO.CancelError = True ' cdPO.Flags = 64 ' cdPO.Action = 5 strMSG = "Answer YES to Print Checklist by Stock #" strMSG = strMSG & vbCrLf & vbCrLf & " Click NO For More Selections" intYN3 = MsgBox(strMSG, vbQuestion + vbYesNo, "Sort By Stock #") ' intYN3 = MsgBox("Do You Want To Print A CheckList by Stock #", vbQuestion + vbYesNo, "Print Checklist") If intYN3 = vbNo Then strMSG = "Answer YES to Print Checklist by Description" strMSG = strMSG & vbCrLf & vbCrLf & " Click NO For More Selections" intYN = MsgBox(strMSG, vbQuestion + vbYesNo, "Sort By Description") ' intYN = MsgBox("Do You Want To Print A CheckList by Description", vbYesNo, "Print Checklist") End If ' If intYN = vbNo Then If intYN = vbNo And intYN3 = vbNo Then strMSG = "Answer YES to Print A Checklist With No Zeros In Stock # Order" strMSG = strMSG & vbCrLf & vbCrLf & " Click NO For More Selections" intYN4 = MsgBox(strMSG, vbQuestion + vbYesNo, "No Zeros by Stock #") End If If intYN = vbNo And intYN3 = vbNo And intYN4 = vbNo Then strMSG = "Answer YES to Print A Checklist With No Zeros In Description Order" strMSG = strMSG & vbCrLf & vbCrLf & " Click NO For More Selections" intYN5 = MsgBox(strMSG, vbQuestion + vbYesNo, "No Zeros by Description") End If If intYN = vbNo And intYN3 = vbNo And intYN4 = vbNo And intYN5 = vbNo Then strMSG = "Answer YES to Print A Checklist With Barcodes in Stock # Order" strMSG = strMSG & vbCrLf & vbCrLf & " Click NO To Exit Without Printing Anything" intYN6 = MsgBox(strMSG, vbQuestion + vbYesNo, "Barcodes by Stock No.") End If ' End If ' If intYN5 = vbNo Then ' Exit Sub ' End If If intYN3 = vbYes Then strFILE = "\POCheckSTK.rpt" End If If intYN = vbYes Then strFILE = "\POCheckDESC.rpt" End If If intYN4 = vbYes Then strFILE = "\POCheckNoZero.rpt" End If If intYN5 = vbYes Then strFILE = "\POCheckNoZeroD.rpt" ' ElseIf intYN5 = vbNo Then ' Exit Sub End If If intYN6 = vbYes Then strFILE = "\POCheckCP.rpt" ElseIf intYN6 = vbNo Then Exit Sub End If intYN2 = MsgBox("Do You Want To Print To Printer?", vbYesNo, "Print to Printer") crPO.ReportFileName = App.Path & strFILE crPO.GroupSelectionFormula = "{tblPOlist.User}= '" & gstrLOGIN & "'" ' crPO.ReportFileName = PO.rpt If intYN2 = vbYes Then cdPO.CancelError = True cdPO.Flags = 64 cdPO.Action = 5 gintDEST = crptToPrinter Else gintDEST = crptToWindow End If crPO.PrinterCopies = 1 crPO.Destination = gintDEST crPO.Action = 1 ' End If Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdPrint" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdPromo_Click() If gbytSECURITY = 2 Then MsgBox "You Should Not Be Adding Promo Detail - Get A Manager Or See Darv", vbOKOnly, "UnAuthorized" Exit Sub End If frmPromo.Show 1 End Sub Private Sub cmdSales_Click() frmInvUsed.Show 1 Call Inventory2Load End Sub Private Sub cmdTEST2_Click() frmInvAdd2.Show 1 Call Inventory2Load End Sub Private Sub lstInventory_Click() 'Dim intTEST As Integer ' intTEST = lstInventory.ListIndex ' lblCount1 = mintCnt1 ' lblCount2 = mintCnt2 ' DoEvents ' lblTest = intTEST ' inttext = lstInventory.ListIndex ' mintBOOKMARK12 = lstInventory.ListIndex ' = mintbookmark12 End Sub Private Sub mnuAddInvO_Click() Call cmdTest_Click Call Inventory2Load End Sub Private Sub mnuAddS_Click() If gbytSECURITY = 2 Then MsgBox "You Should Not Be Adding Inventory - Get A Manager Or See Darv", vbOKOnly, "UnAuthorized" Exit Sub End If frmInvStore.Show 1 Call Inventory2Load End Sub Private Sub mnuAddV_Click() If gbytSECURITY = 2 Then MsgBox "You Should Not Be Adding Inventory - Get A Manager Or See Darv", vbOKOnly, "UnAuthorized" Exit Sub End If Call mnuAddInvO_Click End Sub Private Sub mnuCreate2_Click() lblBegSelect.Visible = False lblEndSelect.Visible = False txtEndSelect.Visible = False txtBegSelect.Visible = False txtBegDate.Visible = False txtEndDate.Visible = False lblBegDate.Visible = False lblEndDate.Visible = False cboVendor.Action = 6 Call VendLoad lblSelectVend.Visible = True cboVendor.Visible = True cboVendor.SetFocus End Sub Private Sub VendLoad() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCITY As String, strVEND As String, strPHONE As String, strFAX As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCITY As Long, lngVEND As Long, lngPHONE As Long, lngFAX As Long Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = gstrCOMPANY & "APMSD" db = d4open(cb, fPath + strSQL) rc = d4top(db) cboVendor.Clear cboVendor.SortState = SortStateSuspend If d4top(db) = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngRECORD = d4field(db, "AP_FIELD01") strCode = Trim(f4str(lngRECORD)) If strCode = "Y" Then With cboVendor lngNAME = d4field(db, "AP_NAME") lngVEND = d4field(db, "AP_VENDOR") strNAME = f4str(lngNAME) strVEND = f4str(lngVEND) .AddItem "A" & vbTab & strVEND & vbTab & strNAME '& vbTab & strCITY & vbTab & Format(strPHONE, "(###) ###-####") & vbTab & Format(strFAX, "(###) ###-####") End With End If End If rc = d4skip(db, 1) oSTATUS = rc Loop While rc = r4success End If rc = d4close(db) cboVendor.SortState = SortStateActiveReSort If cboVendor.ListCount Then cboVendor.ListIndex = 0 Else MsgBox "No Vendors Were Found", vbInformation + vbOKOnly, "No Vendors" End If ' cboVendor.SortState = SortStateActiveReSort Exit Sub Error_EH: gstrMODULE = "Form PO - Module VendLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuHelp_Click() Dim strMSG As String ' strMSG = "Ctrl-O = Show A List Of All Purchases For The Highlited Item" & vbCrLf ' strMSG = strMSG & " The Check Box At The Bottom Determines Inventory List or PO List" & vbCrLf strMSG = " The Check Box At The Bottom Determines Inventory List or PO List" & vbCrLf strMSG = strMSG & " F5 = Reload The Inventory List (Will Update Any Changes Made" & vbCrLf strMSG = strMSG & "F11 = Move The Highlite Line To The Same Place As The Before The Last Action" & vbCrLf strMSG = strMSG & "Ctrl-G = Show A List Of All Vendors For The Highlited Item" & vbCrLf strMSG = strMSG & "Ctrl-K = Set Order Qty To Zero For All Items In The PO List (Must ReEnter" & vbCrLf strMSG = strMSG & "Ctrl-D = Display A List Of Every PO That The Highlited Item Was Deleted" & vbCrLf strMSG = strMSG & "Ctrl-H = Update The Cost For The Highlighted Item In The Order List" & vbCrLf strMSG = strMSG & "Ctrl-O = Display A List Of Every PO That Was Placed For The Highlited Item" & vbCrLf strMSG = strMSG & "Ctrl-U = ReCalc The OnOrder Amount For The Item That Is Higlighted In The CMS Inventory List" & vbCrLf strMSG = strMSG MsgBox strMSG, vbOKOnly, "Information Screen" End Sub Private Sub mnuRenumber_Click() frmInvtry3.Show 1 End Sub Private Sub mnuUpDesc_Click() Call cmdFixDesc_Click End Sub Private Sub F5On() lblWait.Caption = "Press F5 To Show Updates" lblWait.Visible = True DoEvents End Sub Private Sub F5Off() lblWait.Visible = False lblWait.Caption = "Please Wait" DoEvents End Sub Private Sub cmdUpVendor_Click() Dim ARCode As Long, oSTATUS As Long, lngVENDOR As Long Dim strSQL As String, strFILE As String 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strVENDOR As String, dblALIAS As Double On Error GoTo Error_EH frmVendor.Show 1 ' DoEvents mstrSTOCK = "" mintBOOKMARK = lstInventory.ListIndex lstInventory.col = 0 mstrSTOCK = lstInventory.ColText strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngVENDOR = d4field(db4, "IN_VENDOR") ' strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngVENDOR, gstrVENDOR) ' rc = d4append(db) rc4 = d4flush(db4) End If ' rc = d4seekNext(db, mstrCUSTOMER2) End If ' Loop rc4 = d4close(db4) strFILE = gstrCOMPANY & "INMAT.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "INMXSTOCK3") ' lngInvTag = d4tag(db4, "INMXSTOCK") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngVENDOR = d4field(db4, "INMXVENDOR") ' strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngVENDOR, gstrVENDOR) ' rc = d4append(db) rc4 = d4flush(db4) End If ' rc = d4seekNext(db, mstrCUSTOMER2) End If ' Loop rc4 = d4close(db4) Call F5On ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdUpVendor_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuUpWgt_Click() Dim ARCode As Long, oSTATUS As Long, lngDESC As Long Dim strSQL As String, strFILE As String Dim lngWEIGHT As Long, strWeight As String 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH mstrSTOCK = "" mstrDESC = "" mintBOOKMARK = lstInventory.ListIndex lstInventory.col = 0 mstrSTOCK = lstInventory.ColText lstInventory.col = 10 strDESC = lstInventory.ColText mstrDESC = InputBox("Enter The Package Weight For The Highlighted Item", "New Weight", strDESC) strWeight = Mid(mstrDESC, 1, 3) strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngWEIGHT = d4field(db4, "IN_FIELD07") strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngWEIGHT, strWeight) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) Call F5On ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK + 1 lstInventory.SetFocus Exit Sub Error_EH: gstrMODULE = "Form PO - Module mnuUpWgt" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuUpCase_Click() Dim ARCode As Long, oSTATUS As Long, lngDESC As Long Dim strSQL As String, strFILE As String Dim lngWEIGHT As Long, strWeight As String 'TAG4 pointers Dim lngInvTag As Long 'INDEX4 pointers Dim ind1 As Long Dim intYN As Integer, strDESC As String, dblALIAS As Double On Error GoTo Error_EH mstrSTOCK = "" mstrDESC = "" mintBOOKMARK = lstInventory.ListIndex lstInventory.col = 0 mstrSTOCK = lstInventory.ColText lstInventory.col = 10 strDESC = lstInventory.ColText mstrDESC = InputBox("Enter The Units Per Case For The Highlighted Item", "New Weight", strDESC) strWeight = Mid(mstrDESC, 1, 3) strFILE = gstrCOMPANY & "INMAS.DBF" db4 = d4open(cb, fPath + strFILE) lngInvTag = d4tag(db4, "IN_STOCK2") Call d4tagSelect(db4, lngInvTag) mstrSTOCK = UCase(mstrSTOCK) rc4 = d4seek(db4, mstrSTOCK) If rc4 = r4success Then oSTATUS = d4deleted(db4) If oSTATUS = 0 Then lngWEIGHT = d4field(db4, "IN_FIELD08") strDESC = Trim$(Field2Str(txtDescription)) Call f4assign(lngWEIGHT, strWeight) rc4 = d4flush(db4) End If End If rc4 = d4close(db4) Call F5On ' Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK + 1 ' On Error Resume Next ' DoEvents lstInventory.SetFocus Exit Sub Error_EH: gstrMODULE = "Form PO - Module mnuUpCase" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_Activate() ' mnuRenumber.Visible = False If gstrLOGIN = "DWW" Then frmPO.WindowState = 0 frmPO.Left = 2 frmPO.Top = 2 frmPO.Height = 9600 frmPO.Width = 12000 cmdAPAR.Visible = True ' mnuRenumber.Visible = True End If If gstrLOGIN = "KLB" Then chkByDesc = vbChecked Else chkByDesc = vbUnchecked End If If gstrLOGIN = "CCP" Then cmdAPAR.Visible = True End If ' If chkNoDisplay = vbUnchecked Then ' If lstProcess.ListCount > 0 Then ' lstProcess.ListIndex = 0 ' End If ' End If If gboolInvList Then chkHistory = vbChecked Else chkHistory = vbUnchecked End If frmPO.lblUser = "User: " & gstrLOGIN ' txtBegSelect = "" ' frmPO.Width = 12000 End Sub Private Sub Form_KeyPress(KeyAscii As Integer) Dim strControl As String strControl = frmPO.ActiveControl.Name ' If Screen.ActiveControl <> "cboVendor" Then If strControl <> "cboVendor" Then ' If frmPO.ActiveControl <> frmPO.cboVendor Then If KeyAscii = 27 Then KeyAscii = 0 Unload Me End If End If End Sub Private Sub Form_Load() Dim strSQL As String, strAV As String mboolALIASFOUND = False ' frmPO.Height = 8760 strAV = "SELECT * FROM tblAV ORDER BY StockNo, Vendor" Set moRSAV = New Recordset moRSAV.Open strAV, goConn, adOpenDynamic, adLockOptimistic mintCnt1 = 0 mintCnt2 = 0 lblCount1 = mintCnt1 lblCount2 = mintCnt2 Call InventoryLoad strSQL = "SELECT * FROM tblPOList WHERE User = '" & gstrLOGIN & "'" Set moRSPOList = New Recordset moRSPOList.Open strSQL, goConn, adOpenKeyset, adLockOptimistic cboSort.ListIndex = gbytPOSort ' cboSort.ListIndex = 0 If moRSPOList.RecordCount > 0 Then Call Inventory2Load End If frmPO.Caption = frmPO.Caption & " -- " & gstrCOMPANY & " -- " & gstrLOGIN frmPO.Width = 12000 frmPO.Height = 9600 If gstrLOGIN = "DWW" Then ' cmdPromo.Visible = True ' mnuAddInv.Visible = True Else ' mnuAddInv.Visible = False End If mbytSort = cboSort.ListIndex ' If gboolConn3Bad Then ' MsgBox "History Files From All Stores Are Not Available - Call Darv", vbOKOnly, "No History" ' End If ' mnuAddInv ' If lstProcess.ListCount > 0 Then ' lstProcess.ListIndex = 0 ' End If End Sub Private Sub lstInventory_DblClick() Dim oRS As Recordset Dim strSQL As String, strSQL2 As String Dim strINVNO As String, strDESC As String, strVEND As String Dim strTYPE As String, dblONHAND As Double Dim dblMIN As Double, dblMAX As Double, dblAVAILABLE As Double Dim dblOrder As Double, intYN As Integer, strMSG As String, intWHOLE As Integer Dim dblLASTCOST As Double, dblRETAIL1 As Double, dblBUYCON As Double, intREM As Integer Dim dblONORDER As Double, dblALLTOTAL As Double, dblWEIGHT As Double Dim strLOrder As String, strLPur As String, strLSALE As String Dim strWeight As String, strONHAND As String, dblSTDCST As Double On Error Resume Next intYN = vbYes lstInventory.col = 0 strINVNO = lstInventory.ColText lstInventory.col = 1 strDESC = lstInventory.ColText lstInventory.col = 2 strVEND = lstInventory.ColText lstInventory.col = 3 strTYPE = lstInventory.ColText lstInventory.col = 4 dblMIN = lstInventory.ColText lstInventory.col = 5 dblMAX = lstInventory.ColText lstInventory.col = 6 dblAVAILABLE = lstInventory.ColText lstInventory.col = 10 dblONORDER = lstInventory.ColText lstInventory.col = 11 dblWEIGHT = lstInventory.ColText strWeight = lstInventory.ColText ' strWeight = dblWEIGHT dblALLTOTAL = dblONORDER + dblAVAILABLE If dblALLTOTAL < dblMIN Then dblOrder = dblMAX - dblALLTOTAL Else dblOrder = 0 End If lstInventory.col = 7 dblLASTCOST = lstInventory.ColText lstInventory.col = 8 dblRETAIL1 = lstInventory.ColText lstInventory.col = 9 dblBUYCON = lstInventory.ColText intREM = dblOrder Mod dblBUYCON lstInventory.col = 13 strLOrder = lstInventory.ColText lstInventory.col = 14 strLPur = lstInventory.ColText lstInventory.col = 15 strLSALE = lstInventory.ColText lstInventory.col = 18 strONHAND = lstInventory.ColText lstInventory.col = 19 dblSTDCST = lstInventory.ColText If NoDups2("tblPOList", "Inv_No", strINVNO, gstrLOGIN) Then ' intWHOLE = 0 Else MsgBox "You Already Have This Item in This PO", vbCritical + vbOKOnly, "Duplicate Item" Exit Sub End If If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON 'THis makes the order be in full cases/bundles End If If dblOrder <= 0 Then strMSG = "The Hi-Lited Stock Item Has An Order Quantity Of Zero Or Less" strMSG = strMSG & Chr(10) & "Do You Want To Order Anyway?" intYN = MsgBox(strMSG, vbQuestion + vbYesNo, "Order Zero or Less") End If If intYN = vbYes Then moRSPOList.AddNew moRSPOList!inv_no = Field2Str(strINVNO) moRSPOList!Description = Field2Str(strDESC) moRSPOList!VENDOR = Field2Str(strVEND) moRSPOList!Type = Field2Str(strTYPE) moRSPOList!Min = dblMIN moRSPOList!Max = dblMAX moRSPOList!OnOrder = dblONORDER moRSPOList!Available = dblALLTOTAL ' moRSPOList!Available = dblAVAILABLE moRSPOList!Order = dblOrder moRSPOList!OnHand = strONHAND moRSPOList!LastCost = dblLASTCOST moRSPOList!Retail1 = dblRETAIL1 moRSPOList!Weight = dblWEIGHT moRSPOList!User = gstrLOGIN moRSPOList!LastOrder = strLOrder moRSPOList!LastPurchase = strLPur moRSPOList!LastSale = strLSALE moRSPOList!StdCost = dblSTDCST moRSPOList.Update End If Call Inventory2Load lstProcess.ListIndex = lstProcess.ListCount - 1 Exit Sub Error_EH: gstrMODULE = "Form PO - Module lstInventory_DblClick" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Inventory2Load() Dim oSTATUS As Long Dim oRS As Recordset Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long, dblTotalWgt As Double, dblPOTotal As Double Dim intYN As Integer, strYN As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = "SELECT * FROM tblPOList WHERE User = '" & gstrLOGIN & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lstProcess.Clear lstProcess.SortState = SortStateSuspend Do Until oRS.EOF ' intYN = Field2CheckBox(oRS!FixAV) ' If intYN = vbChecked Then ' strYN = "UV" ' Else ' strYN = " " ' End If lstProcess.AddItem Field2Str(oRS!inv_no) & vbTab & Field2Str(oRS!Description) & vbTab & Field2Str(oRS!VENDOR) & vbTab & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!Min) & vbTab & Field2Str(oRS!Max) & vbTab & Field2Str(oRS!Available) & vbTab & Field2Str(oRS!Order) & vbTab & Field2Str(oRS!LastCost) & vbTab & Field2Str(oRS!ListID) & vbTab & Field2Str2(oRS!Weight) & vbTab & Field2Str(oRS!LastOrder) & vbTab & Field2Str(oRS!LastPurchase) & vbTab & Field2Str(oRS!LastSale) & vbTab & Format(Field2Str(oRS!Retail1), "#,#0.00") & vbTab & Format(Field2Str(oRS!StdCost), "#,#0.00") dblTotalWgt = dblTotalWgt + (Field2Str2(oRS!Weight) * Field2Str2(oRS!Order)) dblPOTotal = dblPOTotal + (Field2Str2(oRS!Order) * Field2Str(oRS!LastCost)) oRS.MoveNext Loop ' End If oRS.Close ' If lstProcess.ListCount Then ' lstProcess.ListIndex = 0 ' End If lstProcess.SortState = SortStateActiveReSort txtWeight = Format(dblTotalWgt, "#,#") txtPOTotal = Format(dblPOTotal, "#,#.00") Exit Sub Error_EH: gstrMODULE = "Form PO - Module Inventory2Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown Dim intBookmark As Integer, intTEST As Integer, intBOOKMARK9 As Integer Dim strSQL As String, oRS As Recordset, intORDER As Integer Dim boolPOLIST As Boolean, boolPOOrder As Boolean, strNNCOST As String Dim strNCOST As String, oRSF As Recordset, strSQLF As String, lngListID As Long Dim strSTDCST As String 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 = vbKeyF11 Then ' Display key combinations. lstInventory.ListIndex = mintBOOKMARK12 lstProcess.ListIndex = mintBOOKMARK13 End If If KeyCode = vbKeyF5 Then ' Display key combinations. Call F5Off mintBOOKMARK12 = lstInventory.ListIndex lblWait.Caption = "Reloading Inventory" lblWait.Visible = True DoEvents Call InventoryLoad lstInventory.ListIndex = mintBOOKMARK12 lblWait.Visible = False lblWait.Caption = "Please Wait" End If If KeyCode = vbKeyF12 Then ' Display key combinations. ' If CtrlDown Then ' If gbytSECURITY <> 2 Then ' If gstrLOGIN = "DWW" Then lstInventory.col = 17 gstrIMAGE = Trim$(lstInventory.ColText) If Len(gstrIMAGE) > 0 Then frmImage.Show 1 Else MsgBox "No Image File Is Available", vbOKOnly, "No Image" Exit Sub End If ' Call cmdTest_Click ' Call Inventory2Load ' Call UpdatePRList ' End If ' End If Exit Sub End If If KeyCode = vbKeyQ Then ' Same as adding inventory from another store. If CtrlDown Then ' If gbytSECURITY <> 2 Then If gstrLOGIN = "DWW" Then ' Call cmdTest_Click frmInvStore.Show 1 Call Inventory2Load ' Call UpdatePRList End If End If Exit Sub End If If KeyCode = vbKeyG Then ' And gbytSECURITY < 3 Then ' Display Alternate Vendors If CtrlDown Then txtOrderQty.SetFocus DoEvents mintBOOKMARK3 = lstInventory.ListIndex mintBOOKMARK12 = lstInventory.ListIndex mintBOOKMARK13 = lstProcess.ListIndex lstInventory.col = 0 gstrSTOCK = CStr(lstInventory.ColText) lstInventory.col = 1 gstrDESC = CStr(lstInventory.ColText) lstInventory.SortState = SortStateSuspend frmVendAlt.Show 1 ' Call InventoryLoad lstInventory.SortState = SortStateActive lstInventory.ListIndex = mintBOOKMARK3 KeyCode = vbKeyF5 DoEvents KeyCode = vbKeyF11 DoEvents End If Exit Sub End If If KeyCode = vbKeyO Then ' And gbytSECURITY < 3 Then ' Show where the highlited items has been purchased ' If chkNoDisplay = vbUnchecked Then ' chkNoDisplay = vbChecked ' End If mintBOOKMARK12 = lstInventory.ListIndex mintBOOKMARK13 = lstProcess.ListIndex If CtrlDown Then If chkHistory = vbChecked Then lstInventory.col = 0 gstrONORDER = lstInventory.ColText lstInventory.col = 1 gstrDESC = lstInventory.ColText lstInventory.col = 2 gstrVENDOR = lstInventory.ColText lstInventory.col = 9 gstrAVAIL = lstInventory.ColText lstInventory.col = 10 gstrOrderAmt = lstInventory.ColText lstInventory.col = 19 gdblSTDCST = lstInventory.ColText intBOOKMARK9 = lstInventory.ListIndex frmOnOrder2.Show 1 lstInventory.ListIndex = intBOOKMARK9 Else lstProcess.col = 0 gstrONORDER = lstProcess.ColText lstProcess.col = 1 gstrDESC = lstProcess.ColText lstProcess.col = 2 gstrVENDOR = lstProcess.ColText intBOOKMARK9 = lstProcess.ListIndex frmOnOrder2.Show 1 lstProcess.ListIndex = intBOOKMARK9 End If End If ' lstInventory.ListIndex = mintBOOKMARK12 KeyCode = vbKeyF11 DoEvents Exit Sub End If ' If KeyCode = vbKeyL Then ' And gbytSECURITY < 3 Then ' Display key combinations. ' If CtrlDown Then ' lstProcess.Col = 0 ' gstrONORDER = lstProcess.ColText ' lstProcess.Col = 1 ' gstrDESC = lstProcess.ColText ' lstProcess.Col = 2 ' gstrVENDOR = lstProcess.ColText ' intBOOKMARK9 = lstProcess.ListIndex ' mintBOOKMARK5 = lstInventory.ListIndex ' frmOnOrder2.Show 1 ' lstProcess.ListIndex = intBOOKMARK9 ' lstInventory.ListIndex = mintBOOKMARK5 ' End If ' Exit Sub ' End If If KeyCode = vbKeyD Then ' And gbytSECURITY < 3 Then ' Show items deleted If CtrlDown Then mintBOOKMARK12 = lstInventory.ListIndex mintBOOKMARK5 = lstInventory.ListIndex lstInventory.col = 0 gstrONORDER = lstInventory.ColText lstInventory.col = 1 gstrDESC = lstInventory.ColText lstInventory.col = 2 gstrVENDOR = lstInventory.ColText mintBOOKMARK5 = lstInventory.ListIndex frmOnOrder3.Show 1 lstInventory.ListIndex = mintBOOKMARK5 End If KeyCode = vbKeyF11 Exit Sub End If If KeyCode = vbKeyK Then ' Changes the Order QTY to 0 - Must reEnter the Desired Qty If CtrlDown Then ' strSQL = "UPDATE tblPOList SET Order = 0" 'WHERE User = '" & gstrLOGIN & "'" ' goConn.Execute strSQL strSQL = "SELECT * FROM tblPOList WHERE User = '" & gstrLOGIN & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF ' intORDER = Field2Str2(oRS!Order) oRS!Order = 0 oRS.Update oRS.MoveNext Loop Call Inventory2Load lstProcess.ListIndex = 0 End If Exit Sub End If If KeyCode = vbKeyA Then If CtrlDown Then End If End If If KeyCode = vbKeyW Then If CtrlDown Then If lstProcess.ListIndex = -1 Then MsgBox "Select An Item From The Order List and Try Again", vbOKOnly, "Wrong Item" Exit Sub Else mintBOOKMARK12 = lstProcess.ListIndex DoEvents lstProcess.col = 8 strNCOST = lstProcess.ColText lstProcess.col = 9 lngListID = Field2Str2(lstProcess.ColText) lstProcess.col = 15 strSTDCST = Field2Str2(lstProcess.ColText) If strSTDCST = "0" Then MsgBox "BuyIn Price Cannot Be Zero", vbOKOnly, "Price = 0" Exit Sub End If ' strNCOST = InputBox("Enter The Last Cost You Want To Use", "New Last Cost", strNCOST) ' If strNCOST = "" Then ' MsgBox "Cancel or ESC Was Pressed", vbOKOnly, "Cancel/ESC" ' Exit Sub ' End If strSQLF = "SELECT * FROM tblPOList WHERE ListID = " & lngListID Set oRSF = New Recordset oRSF.Open strSQLF, goConn, adOpenDynamic, adLockOptimistic If Not oRSF.EOF Then oRSF!LastCost = Field2Str2(strSTDCST) oRSF.Update End If Call Inventory2Load lstProcess.ListIndex = mintBOOKMARK12 End If End If End If If KeyCode = vbKeyH Then '** UpDate the Last Cost for the highlighted item If CtrlDown Then If lstProcess.ListIndex = -1 Then MsgBox "Select An Item From The Order List and Try Again", vbOKOnly, "Wrong Item" Exit Sub Else mintBOOKMARK12 = lstProcess.ListIndex DoEvents lstProcess.col = 8 strNCOST = lstProcess.ColText lstProcess.col = 9 lngListID = Field2Str2(lstProcess.ColText) strNCOST = InputBox("Enter The Last Cost You Want To Use", "New Last Cost", strNCOST) If strNCOST = "" Then MsgBox "Cancel or ESC Was Pressed", vbOKOnly, "Cancel/ESC" Exit Sub End If strSQLF = "SELECT * FROM tblPOList WHERE ListID = " & lngListID Set oRSF = New Recordset oRSF.Open strSQLF, goConn, adOpenDynamic, adLockOptimistic If Not oRSF.EOF Then oRSF!LastCost = Field2Str2(strNCOST) oRSF.Update End If Call Inventory2Load lstProcess.ListIndex = mintBOOKMARK12 End If End If End If If KeyCode = vbKeyU Then 'UPdates The On Order Amount for the highlited item If CtrlDown Then If lstInventory.ListIndex = -1 Then MsgBox "Select An Item From The Inventry List and Try Again", vbOKOnly, "Wrong Item" Exit Sub Else mintBOOKMARK12 = lstInventory.ListIndex lblWait.Visible = True lblWait.Caption = "ReCalculate On Order" DoEvents Call ChgONOrder Call FixONOrder lstInventory.Refresh lblWait.Visible = False lblWait.Caption = "Please Wait" lstInventory.ListIndex = mintBOOKMARK12 End If End If End If End Sub Private Sub lstProcess_Click() Dim oRS As Recordset, oRSU As Recordset, strSQLL As String, strTIP2 As String, strTIP As String Dim strSQL As String, strSTOCK As String, strDESC As String, dblQTY As Double, strNA As String Dim strLOrder As String, strLPur As String, strLSALE As String ' strNA As String Dim sglSTDCST As Single lstCompare.Clear lstHistory.Clear ' lstProcess.TextTipDelay = 50 lstProcess.col = 0 mstrFStock = lstProcess.ColText lstProcess.col = 9 strSTOCK = lstProcess.ColText lblMessage = "" lblMessage.Visible = False lblTest = "" ' strSTOCK = lstProcess.ColText strNA = "N/A" If strSTOCK <> "" Then strSQL = "SELECT * FROM tblPOList WHERE ListID = " & strSTOCK ' & """" Set moRSUpdate = New Recordset moRSUpdate.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lblStock = moRSUpdate!inv_no lblShowDesc = moRSUpdate!Description txtOrderQty = moRSUpdate!Order lblOrderHold = moRSUpdate!Order strLOrder = Field2Str(moRSUpdate!LastOrder) strLOrder = Format(strLOrder, "####/##/##") strLPur = Field2Str(moRSUpdate!LastPurchase) strLPur = Format(strLPur, "####/##/##") strLSALE = Field2Str(moRSUpdate!LastSale) strLSALE = Format(strLSALE, "####/##/##") sglSTDCST = Field2Str2(moRSUpdate!StdCost) sglSTDCST = Format(sglSTDCST, "#,#0.00") lblTest = "Last Order - " & Trim(strLOrder) & vbCrLf lblTest = lblTest & "Last Purchase - " & Trim(strLPur) & vbCrLf lblTest = lblTest & "Last Sale - " & Trim(strLSALE) & vbCrLf If sglSTDCST > 0 Then lblTest = lblTest & "Buyin Amt - " & Format(sglSTDCST, "#,#0.00") End If ' lblTest = lblTest & "Std Cost - " & sglSTDCST ' If Not gboolConn3Bad Then Call GetTSSHist Call GetAFNHist Call GetAFSHist ' Else ' MsgBox "History Files From All Store Not Available - Call Darv", vbOKOnly, "No History" ' End If If gstrCOMPANY = "TSS" Then If mstrT_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & mstrT_LM & vbTab & mstrT_LY & vbTab & mstrT_YA & vbTab & mstrT_ICLM & vbTab & mstrT_ICLY & vbTab & mstrT_ICYA) Else lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrN_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("AFN" & vbTab & mstrN_LM & vbTab & mstrN_LY & vbTab & mstrN_YA & vbTab & mstrN_ICLM & vbTab & mstrN_ICLY & vbTab & mstrN_ICYA) Else lstHistory.AddItem ("AFN" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrS_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("AFS" & vbTab & mstrS_LM & vbTab & mstrS_LY & vbTab & mstrS_YA & vbTab & mstrS_ICLM & vbTab & mstrS_ICLY & vbTab & mstrS_ICYA) Else lstHistory.AddItem ("AFS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If End If If gstrCOMPANY = "AFN" Then If mstrN_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & mstrN_LM & vbTab & mstrN_LY & vbTab & mstrN_YA & vbTab & mstrN_ICLM & vbTab & mstrN_ICLY & vbTab & mstrN_ICYA) Else lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrT_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("TSS" & vbTab & mstrT_LM & vbTab & mstrT_LY & vbTab & mstrT_YA & vbTab & mstrT_ICLM & vbTab & mstrT_ICLY & vbTab & mstrT_ICYA) Else lstHistory.AddItem ("TSS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrS_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("AFS" & vbTab & mstrS_LM & vbTab & mstrS_LY & vbTab & mstrS_YA & vbTab & mstrS_ICLM & vbTab & mstrS_ICLY & vbTab & mstrS_ICYA) Else lstHistory.AddItem ("AFS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If End If If gstrCOMPANY = "AFS" Then If mstrS_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & mstrS_LM & vbTab & mstrS_LY & vbTab & mstrS_YA & vbTab & mstrS_ICLM & vbTab & mstrS_ICLY & vbTab & mstrS_ICYA) Else lstHistory.AddItem (Trim(moRSUpdate!inv_no) & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrT_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("TSS" & vbTab & mstrT_LM & vbTab & mstrT_LY & vbTab & mstrT_YA & vbTab & mstrT_ICLM & vbTab & mstrT_ICLY & vbTab & mstrT_ICYA) Else lstHistory.AddItem ("TSS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If If mstrN_LM <> " NO SALES INFORMATION FOUND " Then lstHistory.AddItem ("AFN" & vbTab & mstrN_LM & vbTab & mstrN_LY & vbTab & mstrN_YA & vbTab & mstrN_ICLM & vbTab & mstrN_ICLY & vbTab & mstrN_ICYA) Else lstHistory.AddItem ("AFN" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) End If End If ' lblMessage.Visible = True ' lblMessage = strTIP If lstProcess.ListCount <> 0 Then If gstrCOMPANY = "TSS" Then ' If Not gboolConn3Bad Then Call GetAFN Call GetAFS ' Else ' End If If mstrN_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("AFN" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("AFN" & vbTab & mstrN_LC & vbTab & mstrN_RTL & vbTab & mstrN_VND & vbTab & mstrN_VS & vbTab & mstrN_LPD & vbTab & mstrN_Desc & vbTab & mstrN_TY) End If If mstrS_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("AFS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("AFS" & vbTab & mstrS_LC & vbTab & mstrS_RTL & vbTab & mstrS_VND & vbTab & mstrS_VS & vbTab & mstrS_LPD & vbTab & mstrS_Desc & vbTab & mstrS_TY) End If End If If gstrCOMPANY = "AFN" Then Call GetTSS Call GetAFS If mstrT_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("TSS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("TSS" & vbTab & mstrT_LC & vbTab & mstrT_RTL & vbTab & mstrT_VND & vbTab & mstrT_VS & vbTab & mstrT_LPD & vbTab & mstrT_Desc & vbTab & mstrT_TY) End If If mstrS_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("AFS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("AFS" & vbTab & mstrS_LC & vbTab & mstrS_RTL & vbTab & mstrS_VND & vbTab & mstrS_VS & vbTab & mstrS_LPD & vbTab & mstrS_Desc & vbTab & mstrS_TY) End If End If If gstrCOMPANY = "AFS" Then Call GetAFN Call GetTSS If mstrN_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("AFN" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("AFN" & vbTab & mstrN_LC & vbTab & mstrN_RTL & vbTab & mstrN_VND & vbTab & mstrN_VS & vbTab & mstrN_LPD & vbTab & mstrN_Desc & vbTab & mstrN_TY) End If If mstrT_LC = "NO INFORMATION FOUND" Then lstCompare.AddItem ("TSS" & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA & vbTab & strNA) Else lstCompare.AddItem ("TSS" & vbTab & mstrT_LC & vbTab & mstrT_RTL & vbTab & mstrT_VND & vbTab & mstrT_VS & vbTab & mstrT_LPD & vbTab & mstrT_Desc & vbTab & mstrT_TY) End If End If End If ' lstProcess.ToolTipText = strTIP2 mintBOOKMARK2 = lstProcess.ListIndex txtOrderQty.SetFocus End If End Sub Private Sub lstProcess_DblClick() Dim strSQL As String, strINVNO As String Dim oRS As Recordset, intBookmark As Integer lblMessage.Visible = False lblTest = "" txtOrderQty = "" lstProcess.col = 0 strINVNO = lstProcess.ColText intBookmark = lstProcess.ListIndex ' strSQL = "SELECT * FROM tblPOList WHERE Inv_No = '" & Trim(strINVNO) & "'" ' Set oRS = New Recordset ' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' If Not oRS.EOF Then moRSUpdate.Delete ' End If Call Inventory2Load If intBookmark >= lstProcess.ListCount Then intBookmark = lstProcess.ListCount - 1 End If lstProcess.ListIndex = intBookmark ' txtOrderQty.SetFocus End Sub Private Sub cmdSetDate_Click() Dim strMSG As String, intYN As Integer Dim strBEGDATE As String Dim strENDDATE As String Dim intMONTH As Integer, intYEAR As Integer strMSG = "Enter the beginning date for Inventory Calculations (MM/DD/YYYY)" lblBegDate.Visible = True lblEndDate.Visible = True lblBegDate2.Visible = True lblEndDate2.Visible = True lblBegDate2 = "" lblEndDate2 = "" intMONTH = Month(Date) intYEAR = Year(Date) intYN = MsgBox("Do You Want To Set The Dates At The Last 30 Days?", vbQuestion + vbYesNo, "Set Date") If intYN = vbYes Then strBEGDATE = Date - 30 strENDDATE = Date GoTo FixDate End If intYN = MsgBox("Do You Want To Set The Dates At The Last Fiscal Year (Oct-Sep)?", vbQuestion + vbYesNo, "Set Date") If intYN = vbYes Then If intMONTH >= 10 Then strBEGDATE = "10/01/" & Trim(Str(intYEAR - 1)) & "" strENDDATE = "09/30/" & Trim(Str(intYEAR)) & "" Else strBEGDATE = "10/01/" & Trim(Str(intYEAR - 2)) & "" strENDDATE = "09/30/" & Trim(Str(intYEAR - 1)) & "" End If GoTo FixDate End If intYN = MsgBox("Do You Want To Set The Dates At The Last Year?", vbQuestion + vbYesNo, "Set Date") If intYN = vbYes Then strBEGDATE = Date - 365 strENDDATE = Date GoTo FixDate End If strBEGDATE = InputBox(strMSG, "Beginning Date") If IsDate(strBEGDATE) Then Else If Len(strBEGDATE) > 0 Then strBEGDATE = Format(strBEGDATE, "00/00/####") If Not IsDate(strBEGDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strMSG = "Enter the ending date for Inventory Calculations (MM/DD/YYYY)" strENDDATE = InputBox(strMSG, "Ending Date") If IsDate(strENDDATE) Then Else If Len(strENDDATE) > 0 Then strENDDATE = Format(strENDDATE, "00/00/####") If Not IsDate(strENDDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If FixDate: lblBegDate2 = strBEGDATE lblEndDate2 = strENDDATE mstrBEGDATE = Year(strBEGDATE) & "/" & Format(Month(strBEGDATE), "00") & "/" & Format(Day(strBEGDATE), "00") mstrENDDATE = Year(strENDDATE) & "/" & Format(Month(strENDDATE), "00") & "/" & Format(Day(strENDDATE), "00") strENDDATE = "" End Sub Private Sub mnuBegDate_Click() Dim strMSG As String, intYN As Integer, intYN2 As Index, intYN3 As Integer intYN = MsgBox("Do You Want The Last Week", vbQuestion + vbYesNo) If intYN = vbYes Then txtBegDate = Date - 8 txtEndDate = Date - 1 End If strMSG = "Enter the beginning date for Purchase Order Calculations (MM/DD/YYYY)" txtBegDate = InputBox(strMSG, "Beginning Date", txtBegDate) If IsDate(txtBegDate) Then Else If Len(txtBegDate) > 0 Then txtBegDate = Format(txtBegDate, "00/00/####") If Not IsDate(txtBegDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strMSG = "Enter the ending date for Purchase Order Calculations (MM/DD/YYYY)" txtEndDate = InputBox(strMSG, "Ending Date", txtEndDate) If IsDate(txtEndDate) Then Else If Len(txtEndDate) > 0 Then txtEndDate = Format(txtEndDate, "00/00/####") If Not IsDate(txtEndDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If End Sub Private Sub mnuBegin_Click() Call cmdSetBeg_Click End Sub Private Sub mnuClear_Click() Call cmdClear_Click End Sub Private Sub mnuCPet_Click() Dim strVSTOCK As String, strSTOCK As String, strVDESC As String Dim strQTY As String, strCOST As String, strINVNO As String Dim strINPUT As String, strSQL As String, strFILE As String Dim strFLAG As String, intAUX As Integer, strTEST As String Dim strSQLL As String, intTAB As Integer, intSTART As Integer, intOLD As Integer Dim intLINENO As Integer, strTEST1 As String Dim strCKStock As String, strCKVStock As String 'Import data from e-mailed file into table for subsiquent import into PO table 'Need pricing report for this to be useful On Error GoTo Error_EH ' strSQL = "DELETE * FROM " & mstrTABLE 'tblCPImport" strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL cdPO.Action = 1 strFILE = cdPO.FileName mstrDATE = InputBox("Enter The Central Pet Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If MousePointer = 11 ' strSQL = "SELECT * FROM " & mstrTABLE 'tblCPImport" ' strSQL = "SELECT * FROM tblCPImport ORDER By LineNo" strSQL = "SELECT * FROM tblCPImport" ' ORDER By LineNo" Set moRSInv = New Recordset moRSInv.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intLINENO = 1 Open strFILE For Input As #1 Do Until EOF(1) Line Input #1, strINPUT strTEST1 = Mid(strINPUT, 1, 6) If Not Mid(strINPUT, 1, 6) = "VENDOR" Then If Not Mid(strINPUT, 1, 1) = vbTab Then If Not Mid(strINPUT, 1, 2) = "" Then intSTART = 1 With moRSInv intAUX = 0 .AddNew intTAB = InStr(intSTART, strINPUT, Chr(9)) strCKVStock = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) !VStock = strCKVStock ' !vstock = Field2Str(Trim$(Mid(strINPUT, intStart, (intTAB - 1)))) intSTART = intSTART + intTAB intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART strCKStock = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB)))) If strCKStock = "NONE" Then strCKStock = strCKStock & CStr(intLINENO) End If !inv_no = strCKStock ' !Inv_No = Field2Str(Trim$(Mid(strINPUT, intStart, (intTAB)))) ' !Inv_No = Field2Str(Mid(strINPUT, 11, 7)) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !VDesc = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) ' !VDesc = "" intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Order = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Cost = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Invoice = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mstrCP_PO = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) !lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then !VENDOR = "CEN500" ' !VENDOR = "CENTPET" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then !VENDOR = "CENTPET" End If !Description = " " !Type = "" !LastCost = 0 !Retail1 = 0 !InvDate = mstrDATE .Update ' Call UpONOrder End With ' Call UpONOrder End If End If End If Loop moRSInv.Close Close #1 mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then ' mstrVENDOR = "CENTPET" mstrVENDOR = "CEN500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "CENTPET" End If Call GetStock Call CPPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Error_EH: If Err = cdlCancel Then MsgBox "The Import Was Canceled", vbCritical + vbOKOnly, "Cancel" Exit Sub End If gstrMODULE = "Form Main - Module mnuCPet" Call ErrorHandler2 gstrMODULE = "" End Sub Private Sub mnuTVet_Click() Dim strVSTOCK As String, strSTOCK As String, strVDESC As String Dim strQTY As String, strCOST As String, strINVNO As String Dim strINPUT As String, strSQL As String, strFILE As String Dim strFLAG As String, intAUX As Integer, strTEST As String Dim strSQLL As String, intTAB As Integer, intSTART As Integer, intOLD As Integer Dim intLINENO As Integer, strTEST1 As String Dim strCKStock As String, strCKVStock As String 'Import data from e-mailed file into table for subsiquent import into PO table 'Need pricing report for this to be useful On Error GoTo Error_EH ' strSQL = "DELETE * FROM " & mstrTABLE 'tblCPImport" strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL cdPO.Action = 1 strFILE = cdPO.FileName mstrDATE = InputBox("Enter The Thompson Vet Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If MousePointer = 11 ' strSQL = "SELECT * FROM " & mstrTABLE 'tblCPImport" ' strSQL = "SELECT * FROM tblCPImport ORDER By LineNo" strSQL = "SELECT * FROM tblCPImport" ' ORDER By LineNo" Set moRSInv = New Recordset moRSInv.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intLINENO = 1 Open strFILE For Input As #1 Do Until EOF(1) Line Input #1, strINPUT strTEST1 = Mid(strINPUT, 1, 6) If Not Mid(strINPUT, 1, 6) = "VENDOR" Then If Not Mid(strINPUT, 1, 1) = vbTab Then If Not Mid(strINPUT, 1, 2) = "" Then intSTART = 1 With moRSInv intAUX = 0 .AddNew intTAB = InStr(intSTART, strINPUT, Chr(9)) strCKVStock = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) !VStock = strCKVStock ' !vstock = Field2Str(Trim$(Mid(strINPUT, intStart, (intTAB - 1)))) intSTART = intSTART + intTAB intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART strCKStock = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB)))) If strCKStock = "NONE" Then strCKStock = strCKStock & CStr(intLINENO) End If If strCKStock = "" Then strCKStock = strCKVStock End If !inv_no = strCKStock ' !Inv_No = Field2Str(Trim$(Mid(strINPUT, intStart, (intTAB)))) ' !Inv_No = Field2Str(Mid(strINPUT, 11, 7)) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !VDesc = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) ' !VDesc = "" intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Order = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Cost = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Invoice = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mstrCP_PO = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) !lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then !VENDOR = "THO500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then !VENDOR = "THOMVET" End If !Description = " " !Type = "" !LastCost = 0 !Retail1 = 0 !InvDate = mstrDATE .Update ' Call UpONOrder End With ' Call UpONOrder End If End If End If Loop moRSInv.Close Close #1 mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "THO500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "THOMVET" End If Call GetStock Call TVPO ' Call CPPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Error_EH: If Err = cdlCancel Then MsgBox "The Import Was Canceled", vbCritical + vbOKOnly, "Cancel" Exit Sub End If gstrMODULE = "Form Main - Module mnuTVet" Call ErrorHandler2 gstrMODULE = "" End Sub Private Sub mnuEagle_Click() Dim strVSTOCK As String, strSTOCK As String, strVDESC As String Dim strQTY As String, strCOST As String, strINVNO As String Dim strINPUT As String, strSQL As String, strFILE As String Dim strFLAG As String, intAUX As Integer, strTEST As String Dim strSQLL As String, intTAB As Integer, intSTART As Integer, intOLD As Integer Dim intLINENO As Integer, strInv_No As String, strV_Stock As String Dim intLength As Integer, boolINVOICE As Boolean, boolDATE As Boolean Dim strINVOICE As String, strINVDATE As String Dim strTEST1 As String, strTEST2 As String, strTEST3 As String, strTEST4 As String 'Import data from e-mailed file into table for subsiquent import into PO table 'Need pricing report for this to be useful On Error GoTo Error_EH boolINVOICE = False boolDATE = False strSQL = "DELETE * FROM tblEagle" goConn.Execute strSQL cdPO.Action = 1 strFILE = cdPO.FileName mstrDATE = InputBox("Enter The Eagle Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If MousePointer = 11 strSQL = "SELECT * FROM tblEagle ORDER By LineNo" Set moRSInv = New Recordset moRSInv.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intLINENO = 1 Open strFILE For Input As #1 Do Until EOF(1) Line Input #1, strINPUT intLength = Len(strINPUT) If intLength = 73 Then 'And Not boolINVOICE Then strTEST4 = Mid(strINPUT, 1, 7) If strTEST4 = "Cargill" Then strINVOICE = Field2Str(Trim$(Mid(strINPUT, 64, 10))) boolINVOICE = True End If End If If intLength = 77 And Not boolDATE Then strINVDATE = Field2Str(Trim$(Mid(strINPUT, 70, 8))) boolDATE = True End If If intLength = 79 Then strTEST1 = Mid(strINPUT, 1, 8) strTEST2 = Mid(strINPUT, 77, 3) strTEST3 = Mid(strINPUT, 35, 5) If Not (strTEST1 = "Customer" Or strTEST1 = " Please ") Then 'Or Not strTEST2 = "LBS" Then If Not strTEST2 = "LBS" Then If Not strTEST3 = "STORE" Then ' If Not Mid(strINPUT, 1, 8) = "Customer" Or Not Mid(strINPUT, 77, 3) = "LBS" Then intSTART = 18 With moRSInv intAUX = 0 intTAB = 10 'InStr(intSTART, strINPUT, Chr(9)) strV_Stock = Field2Str(Trim$(Mid(strINPUT, intSTART, intTAB))) If Trim(strV_Stock) <> "FS" Then .AddNew !VStock = strV_Stock !VDesc = Field2Str(Trim$(Mid(strINPUT, 28, 25))) intSTART = 1 intTAB = 11 '(InStr(intSTART, strINPUT, Chr(9))) - intSTART !Order = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) intSTART = 53 'intSTART + intTAB + 1 intTAB = 12 '(InStr(intSTART, strINPUT, Chr(9))) - intSTART !Cost = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) !Invoice = strINVOICE 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mstrCP_PO = strINVOICE 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) !lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then !VENDOR = "CAR400" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then !VENDOR = "CARGANI" End If !Description = " " !Type = "" !LastCost = 0 !Retail1 = 0 !InvDate = strINVDATE .Update End If End With End If End If End If End If Loop moRSInv.Close Close #1 mstrTABLE = "tblEagle" If gstrCOMPANY = "TSS" Then mstrVENDOR = "CAR400" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "CARGANI" End If Call GetStock Call EAPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Error_EH: If Err = cdlCancel Then MsgBox "The Import Was Canceled", vbCritical + vbOKOnly, "Cancel" Exit Sub End If gstrMODULE = "Form PO - Module ImportEagle" Call ErrorHandler2 gstrMODULE = "" End Sub Private Sub EAPO() Dim strSQL As String, oRS As Recordset Dim strSQLL As String, oRSS As Recordset Dim dblQORDER As Double, dblQCost As Double, dblEXT As Double Dim lngPOLineNum As Long, lngPOID As Long Dim strINVOICE As String, strTEST As String ' On Error GoTo Error_EH GoSub Set_Header strSQL = "SELECT * FROM tblPODetail" ' WHERE poid = " & glngPOID Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblEagle" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst mstrCP_PO = oRS!Invoice Do Until oRS.EOF strINVOICE = oRS!Invoice If strINVOICE <> mstrCP_PO Then mstrCP_PO = strINVOICE If lngPOLineNum <> 0 Then moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update End If GoSub Set_Header End If dblBUYCON = Field2Str(oRS!buycon) If dblBUYCON > 0 Then dblQORDER = Field2Str2(oRS!Order) dblQORDER = dblQORDER * dblBUYCON dblQCost = Field2Str2(oRS!Cost) dblQCost = dblQCost / dblBUYCON dblQCost = Format(dblQCost, "#,#.0000") dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) Else dblQORDER = Field2Str2(oRS!Order) dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) End If moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!InvLine = oRS!lineno moRSPODetail!lineno = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(oRS!inv_no) mstrSTOCK = Trim(Field2Str(oRS!inv_no)) moRSPODetail!vstockno = oRS!VStock moRSPODetail!Desc = Trim(oRS!Description) strTEST = Left(Trim(oRS!Description), 4) ' moRSPODetail!qty = dblQORDER moRSPODetail!Qty = oRS!Order mdblQORDER = dblQORDER ' mdblQORDER = Field2Str2(oRS!Order) moRSPODetail!Cost = dblQCost ' moRSPODetail!Cost = oRS!Cost ' moRSPODetail!actcost = oRS!Cost moRSPODetail!ActCost = dblQCost moRSPODetail!ActCostO = dblQCost moRSPODetail!LastCost = oRS!LastCost moRSPODetail!Retail1 = oRS!Retail1 moRSPODetail!ExtCost = dblEXT ' moRSPODetail!ExtCost = dblEXT moRSPODetail!AExtCost = dblEXT moRSPODetail!NRetail = oRS!Retail1 ' moRSPODetail!ACTQty = oRS!Order moRSPODetail!BalQty = oRS!Order - moRSPODetail!ACTQty ' moRSPODetail!BalQty = oRS!Order - moRSPODetail!qty moRSPODetail!Type = 5 moRSPODetail!NRetail = oRS!Retail1 moRSPODetail!ACTQty = dblQORDER ' moRSPODetail!ACTQty = oRS!Order moRSPODetail!Weight = Field2Str2(oRS!Weight) If strTEST = "****" Then moRSPODetail!Add = vbChecked Else moRSPODetail!Add = oRS!Add End If moRSPODetail.Update oRS.MoveNext Call UpONOrder Loop moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update lngPOLineNum = 0 Exit Sub Set_Header: lngPOLineNum = 1 strSQLL = "Select * FROM tblProgInfo" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = oRSS!NextPO glngPO = lngNextPO oRSS!NextPO = lngNextPO + 1 oRSS.Update strSQLL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If mstrVENDOR = "CAR400" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "CAR400" moRSPOHeader!vendorname = "Cargill Animal Nutrition" moRSPOHeader!vaddress1 = "P.O. Box 15007" moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "Casa Grande" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85230-5007" moRSPOHeader!VPhone = "(888) 220-6455" moRSPOHeader!VFAX = "(800) 962-3344" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "MARK" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 3 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 0 moRSPOHeader.Update ElseIf mstrVENDOR = "CARGANI" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "CARGANI" moRSPOHeader!vendorname = "Cargill Animal Nutrition" moRSPOHeader!vaddress1 = "P.O. Box 15007" moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "Casa Grande" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85230-5007" moRSPOHeader!VPhone = "(888) 220-6455" moRSPOHeader!VFAX = "(800) 962-3344" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "ANDREW" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 3 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 0 moRSPOHeader.Update End If strSQLL = "SELECT * FROM tblPOHeader WHERE PONUM = " & glngPO ' strSQL = "SELECT * FROM tblPOHeader WHERE PONUM = " & mstrCP_PO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid Return Error_EH: gstrMODULE = "Form PO - Module EAPO" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuLabels_Click() frmLabels.Show 1 End Sub Private Sub mnuLextron_Click() Dim strVSTOCK As String, strSTOCK As String, strVDESC As String Dim strQTY As String, strCOST As String, strINVNO As String Dim strINPUT As String, strSQL As String, strFILE As String Dim strFLAG As String, intAUX As Integer, strTEST As String Dim strSQLL As String, intTAB As Integer, intSTART As Integer, intOLD As Integer Dim intLINENO As Integer 'Import data from e-mailed file into table for subsiquent import into PO table 'Need pricing report for this to be useful On Error GoTo Error_EH ' strSQL = "DELETE * FROM " & mstrTABLE 'tblCPImport" strSQL = "DELETE * FROM tblLextron" goConn.Execute strSQL cdPO.Action = 1 strFILE = cdPO.FileName mstrDATE = InputBox("Enter The Lextron Invoice Date MM/DD/YYYY", "Invoice Date", Date) strPONUM = InputBox("Enter the Orginal PO Number", "PO Number") If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If MousePointer = 11 ' strSQL = "SELECT * FROM " & mstrTABLE 'tblCPImport" strSQL = "SELECT * FROM tblLextron ORDER By LineNo" Set moRSInv = New Recordset moRSInv.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intLINENO = 1 Open strFILE For Input As #1 Do Until EOF(1) Line Input #1, strINPUT ' If Not Mid(strINPUT, 1, 6) = "VENDOR" Then intSTART = 1 With moRSInv intAUX = 0 .AddNew !VStock = Field2Str(Trim$(Mid(strINPUT, intSTART, 10))) intSTART = 14 !VDesc = Field2Str(Trim$(Mid(strINPUT, intSTART, 30))) intSTART = 56 !Order = Field2Str2(Trim$(Mid(strINPUT, intSTART, 6))) intSTART = 61 !Cost = Field2Str2(Trim$(Mid(strINPUT, intSTART, 9))) intSTART = 70 !lineno = intLINENO intLINENO = intLINENO + 1 !VENDOR = "LEX500" !Description = " " !Type = "" !LastCost = 0 !Retail1 = 0 !InvDate = mstrDATE .Update End With Loop moRSInv.Close Close #1 mstrTABLE = "tblLextron" Call GetStock Call LEXPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Error_EH: If Err = cdlCancel Then MsgBox "The Import Was Canceled", vbCritical + vbOKOnly, "Cancel" Exit Sub End If gstrMODULE = "Form Main - Module mnuCPet" Call ErrorHandler2 gstrMODULE = "" Close #1 End Sub Private Sub mnuCreate_Click() Dim intYN As Integer, intYN2 As Integer, strFILE As String, intYN3 As Integer Dim intOK As Integer, intOK2 As Integer, strMSG As String On Error GoTo Error_EH gstrMODULE = "Point 1 " ' lstInventory.SetFocus Call POCreate gstrMODULE = gstrMODULE & "Point 2 " If mintYN = vbNo Then Exit Sub End If gstrMODULE = gstrMODULE & "Point 3 " ' If gstrLOGIN = "DWW" Then If gboolPOPrint Then intYN = MsgBox("Do You Want To Print A PO Now", vbQuestion + vbYesNo + vbDefaultButton2, "Print PO") ', , vbDefaultButton2) Else intYN = MsgBox("Do You Want To Print A PO Now", vbQuestion + vbYesNo + vbDefaultButton1, "Print PO") ', , vbDefaultButton2) End If ' intYN = MsgBox("Do You Want To Print A PO Now", vbYesNo, "Print PO", , vbDefaultButton2) If intYN = vbYes Then cdPO.CancelError = True cdPO.Flags = 64 cdPO.Action = 5 ' &H40 intYN2 = MsgBox("Do You Want To Print To Printer?", vbYesNo, "Print to Printer") intYN3 = MsgBox("Do You Want To Use Vendor Stock #'s", vbYesNo, "Use Vendor Stock") If intYN3 = vbYes Then ' If Not chkByDesc Then If chkByDesc = vbUnchecked Then strFILE = "\POVend.rpt" Else strFILE = "\POVDesc.rpt" End If Else If chkByDesc = vbUnchecked Then strFILE = "\PO.rpt" Else strFILE = "\PODesc.rpt" End If End If crPO.ReportFileName = App.Path & strFILE crPO.GroupSelectionFormula = "{tblPOHeader.PONum}=" & glngPO ' crPO.ReportFileName = PO.rpt If intYN2 = vbYes Then ' cdPO.CancelError = True ' cdPO.Flags = 64 ' cdPO.Action = 5 ' &H40 gintDEST = crptToPrinter Else gintDEST = crptToWindow End If crPO.PrinterCopies = 1 crPO.Destination = gintDEST crPO.Action = 1 End If lblSelectVend.Visible = False cboVendor.Visible = False lblBegSelect.Visible = True lblEndSelect.Visible = True txtEndSelect.Visible = True txtBegSelect.Visible = True txtBegDate.Visible = True txtEndDate.Visible = True lblBegDate.Visible = True lblEndDate.Visible = True Exit Sub Error_EH: gstrMODULE = gstrMODULE & " Form PO - Module mnuCreate" Call ErrorHandler2 gstrMODULE = "" ' Close #1 End Sub Private Sub mnuEnding_Click() Call cmdSetEnd_Click End Sub Private Sub mnuExit_Click() Unload Me End Sub Private Sub mnuMinMax_Click() mboolALL = False ' strMSG = "Do You Want To Update CMS OnOrder Amount Before Creating The New PO?" ' strMSG = strMSG & Chr(10) & "This May Take As Long As 2 Minutes To Run" ' intOK = MsgBox(strMSG, vbYesNo, "Update ONORDER") ' If intOK = vbYes Then ' Call cmdZeroOnOrd_Click ' Call cmdReCalc_Click ' ElseIf intOK = vbNo Then ' End If Call cmdPartial_Click End Sub Private Sub mnuPOSSales_Click() Dim strMSG As String If cboSort.ListIndex <> 2 Or txtBegSelect = "" Or Not IsDate(txtBegDate) Or (txtBegSelect <> txtEndSelect) Then strMSG = "The Select by POS Sales Must have Vendor as the Sort Field and a Beginning & Ending Vendor Selected" strMSG = strMSG & Chr(10) & "Only 1 Vendor Can Be Selected" strMSG = strMSG & Chr(10) & "A Beginning and Ending Date is also Required -- ReEnter" MsgBox strMSG, vbCritical + vbOKOnly, "Vendor Required" ' MsgBox "The Select by POS Sales Must have Vendor as the Sort Field and a Beginning & Ending Vendor Selected", vbOKOnly, "Vendor Required" Exit Sub End If lblMessage.Caption = "Selecting Items Using Seletion Criteria - Be PATIENT" lblMessage.Visible = True DoEvents mboolALL = True Call cmdImportInv_Click Call SelectPartialLoad2 Call CalcSales Call Inventory2Load lblMessage.Visible = False mboolALL = False End Sub Private Sub mnuSelALL_Click() Dim strMSG As String If cboSort.ListIndex <> 2 Or txtBegSelect = "" Then 'Or Not IsDate(txtBegDate) Or (txtBegSelect <> txtEndSelect) Then strMSG = "The Select ALL For 1 Vendor Must have Vendor as the Sort Field and a Beginning & Ending Vendor Selected" strMSG = strMSG & Chr(10) & "Only 1 Vendor Can Be Selected" ' strMSG = strMSG & Chr(10) & "A Beginning and Ending Date is also Required -- ReEnter" MsgBox strMSG, vbCritical + vbOKOnly, "Vendor Required" ' MsgBox "The Select by POS Sales Must have Vendor as the Sort Field and a Beginning & Ending Vendor Selected", vbOKOnly, "Vendor Required" Exit Sub End If lblMessage.Caption = "Selecting Items Using Seletion Criteria - Be PATIENT" lblMessage.Visible = True DoEvents mboolALL = True Call cmdImportInv_Click Call SelectPartialLoad3 ' Call SelectPartialLoad2 ' Call CalcSales Call Inventory2Load lblMessage.Visible = False mboolALL = False End Sub Private Sub CalcSales2() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim lngLSTCOST As Long, lngRETAIL1 As Long Dim dblLSTCOST As String, dblRETAIL1 As String Dim strVEND As String, strTYPE As String, strINVNO As String, strDESC As String * 45 Dim strSELECT As String, strBEG As String * 45, strEND As String * 45 Dim oRS As Recordset Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim dblOrder As Double, dblCost As Double, dblALLTOTAL As Double Dim lngBUYCON As Long, dblBUYCON As Double, intREM As Integer, intWHOLE As Integer Dim lngONORDER As Long, dblONORDER As Double Dim strSTOCK As String, strDATE As String Dim strYEAR As String, strMONTH As String, strDAY As String, strBDATE As String Dim strMSG As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH If Not IsDate(txtBegDate) Then strMSG = "You Must Have Beginning and Ending Date Entered - ReEnter" MsgBox strMSG, vbCritical + vbOKOnly, "InValid Dates" Exit Sub End If gboolVEND = True frmVendor.Show 1 ' On Error Resume Next mlngCOUNT = 0 strBEG = txtBegSelect strEND = txtEndSelect strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic mstrSTOCK = Field2Str(oRS!inv_no) strYEAR = Format(Year(txtBegDate), "0000") strMONTH = Format(Month(txtBegDate), "00") strDAY = Format(Day(txtBegDate), "00") strBDATE = strYEAR + strMONTH + strDAY ' strDATE = txtBegDate strSTOCK = mstrSTOCK + strBDATE strSQL = gstrCOMPANY & "INHIS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INHISTOCK") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, strSTOCK) ' db = d4open(cb, fPath + strSQL) ' rc = d4top(db) ' lstInventory.SortState = SortStateSuspend ' If d4top(db) = r4success Then ' Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then mlngCOUNT = mlngCOUNT + 1 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 dblLSTCOST = 0 dblRETAIL1 = 0 dblCost = 0 lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngLSTCOST = d4field(db, "IN_LSCOST") lngRETAIL1 = d4field(db, "IN_PRICE1") lngBUYCON = d4field(db, "IN_ALTRN1") lngONORDER = d4field(db, "IN_ORDERTE") strINVNO = Trim(f4str(lngNAME)) strDESC = Trim(f4str(lngCUST)) strVEND = Trim(f4str(lngVEND)) strTYPE = Trim(f4str(lngType)) dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblONHAND = f4double(lngONHAND) dblONORDER = f4double(lngONORDER) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblALLTOTAL = dblONORDER + dblAVAIL dblLSTCOST = f4double(lngLSTCOST) dblRETAIL1 = f4double(lngRETAIL1) dblCost = f4double(lngLSTCOST) dblBUYCON = f4double(lngBUYCON) If cboSort.ListIndex = 0 Then If Trim$(strINVNO) >= Trim$(strBEG) And Trim$(strINVNO) <= Trim$(strEND) Then ' If dblAVAIL <= dblMIN Then ' dblOrder = dblMAX - dblAVAIL '**************** If dblALLTOTAL <= dblMIN Then dblOrder = dblMAX - dblALLTOTAL '**************** intREM = dblOrder Mod dblBUYCON If dblBUYCON > 1 And intREM > 0 Then intWHOLE = Int((dblOrder / dblBUYCON) + 0.99) dblOrder = intWHOLE * dblBUYCON ' dblOrder = intWHOLE End If If dblOrder > 0 Then With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str2(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX !Available = dblALLTOTAL ' !Available = dblAVAIL !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !User = gstrLOGIN .Update End With End If End If End If End If rc = d4skip(db, 1) End If rc = d4close(db) oRS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load mlngCOUNT = mlngCOUNT On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module CalcSales" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuPurina_Click() Dim intRow As Integer, boolSTOP As Boolean, intLINENO As Integer Dim strLOCATE As String, strCHECK As String 'Dim strSTONE As String, strDESC As String, dblPRICE As Double Dim dblCost As Double, dblQTY As Double, strSTOCK As String, strDESC As String Dim oRS As Recordset, strSTK_DESC As String Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim strTYPE As String, strINVOICE As String, strCELL As String Dim boolCHECK As Boolean, intCHECK As Integer 'Dim strF1 As String, strF2 As String, strF3 As String, strF4 As String, strF5 As String 'Dim strF6 As String, strF7 As String, strF8 As String, strF9 As String, strF10 As String 'Dim strF11 As String, strF12 As String, strF13 As String, strF14 As String, strF15 As String Dim strF() As String, strDiscCost As String, dblDCost As Double Dim strLine As String, strNET As String, strFIND As String Dim strLINE2 As String, strG() As String Dim strSQLL As String, oRSS As Recordset, strNetCost As String Dim bytLEN As Byte, bytLEN2 As Byte, bytLEN3 As Byte, strASTRICK As String Screen.MousePointer = vbHourglass On Error GoTo Error_EH intLINENO = 1 boolSTOP = False boolCHECK = False intCHECK = 0 cdPO.Action = 1 strLOCATE = cdPO.FileName mstrDATE = InputBox("Enter The Purina Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intRow = 1 Open strLOCATE For Input As #1 Line Input #1, strLine Do Until EOF(1) Line Input #1, strLine If Trim$(strLine) <> "" Then strF = Split(strLine, ",") test0 = Replace(strF(25), Chr(34), "") ''' test0 = Replace(strF(24), Chr(34), "") ' test0 = Replace(strF(23), Chr(34), "") If test0 <> "" And test0 <> "0.00" Then ' If test0 = "HDR10" Then ' strINVOICE = Replace(strF(5), Chr(34), "") Line Input #1, strLINE2 strG = Split(strLINE2, ",") ' ElseIf test0 = "DTL10" Then ' dblQTY = Field2Str2(strG(28)) ''' dblQTY = Replace(strG(28), Chr(34), "") dblQTY = Replace(strG(29), Chr(34), "") '' If lngQTY > 0 Then ' strCELL = Replace(strF(3), Chr(34), "") ' strSTOCK = Mid$(strCELL, 1, 12) ' strDESC = Mid$(strCELL, 16, 30) ' strSTOCK = Replace(strF(2), Chr(34), "") ' strSTOCK = Replace(strG(24), Chr(34), "") strSTOCK = test0 'Replace(strG(24), Chr(34), "") strASTRICK = Right(strSTOCK, 2) If strASTRICK = "**" Then bytLEN3 = Len(strSTOCK) strSTOCK = Left(strSTOCK, (bytLEN3 - 2)) strSTOCK = RTrim(strSTOCK) End If ''' strDESC = Replace(strG(26), Chr(34), "") strDESC = Replace(strG(27), Chr(34), "") strINVOICE = Replace(strG(9), Chr(34), "") dblCost = Replace(strG(37), Chr(34), "") ' dblCost = CDbl(Field2Str2(strG(36))) oRS.AddNew oRS!VStock = strSTOCK oRS!VDesc = strDESC 'Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) oRS!Order = dblQTY 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(dblQTY) oRS!Cost = dblCost 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then oRS!VENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then oRS!VENDOR = "PURIMIL" End If oRS!Description = " " oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!InvDate = mstrDATE oRS!Invoice = strINVOICE oRS.Update ElseIf dblQTY = 0 Then '' strSQLL = "SELECT * FROM tblCPImport WHERE VStock = '" & strSTOCK & "'" '' Set oRSS = New Recordset '' oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic ' strFIND = "VStock = '" & strSTOCK & "'" ' oRS.MoveFirst ' oRS.Find strFIND ' oRS.MoveLast ' strSTOCK = oRS!vstock '' If Not oRSS.EOF Then '' strDiscCost = Replace(strF(3), Chr(34), "") '' strNET = Mid$(strDiscCost, 1, 8) '' If strNET = "Net Cost" Then ' strNetCost = Mid$(strDiscCost, 1, 8) '' bytLEN = Len(strDiscCost) '' bytLEN2 = bytLEN - 8 '' dblDCost = Field2Str2(Right$(strDiscCost, bytLEN2)) ' dblDCost = Field2Str2(Right$(strDiscCost, 10)) '' oRSS!Cost = Round(dblDCost, 4) ' oRS.Save '' oRSS.Update '' End If '' End If '' End If 'May Need To Comment Out End If End If Loop oRS.Close Close (1) mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "PURIMIL" End If Call GetStock Call PURPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" Screen.MousePointer = 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module mnuPurina" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuPurina2_Click() Dim intRow As Integer, boolSTOP As Boolean, intLINENO As Integer Dim strLOCATE As String, strCHECK As String 'Dim strSTONE As String, strDESC As String, dblPRICE As Double Dim dblCost As Double, dblQTY As Double, strSTOCK As String, strDESC As String Dim oRS As Recordset, strSTK_DESC As String Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim strTYPE As String, strINVOICE As String, strCELL As String Dim boolCHECK As Boolean, intCHECK As Integer 'Dim strF1 As String, strF2 As String, strF3 As String, strF4 As String, strF5 As String 'Dim strF6 As String, strF7 As String, strF8 As String, strF9 As String, strF10 As String 'Dim strF11 As String, strF12 As String, strF13 As String, strF14 As String, strF15 As String Dim strF() As String, strDiscCost As String, dblDCost As Double Dim strLine As String, strNET As String, strFIND As String Dim strLINE2 As String, strG() As String Dim strSQLL As String, oRSS As Recordset, strNetCost As String Dim bytLEN As Byte, bytLEN2 As Byte, bytLEN3 As Byte, strASTRICK As String Screen.MousePointer = vbHourglass On Error GoTo Error_EH intLINENO = 1 boolSTOP = False boolCHECK = False intCHECK = 0 cdPO.Action = 1 strLOCATE = cdPO.FileName mstrDATE = InputBox("Enter The Purina Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intRow = 1 Open strLOCATE For Input As #1 Line Input #1, strLine Do Until EOF(1) Line Input #1, strLine If Trim$(strLine) <> "" Then strF = Split(strLine, ",") '''' test0 = Replace(strF(25), Chr(34), "") test0 = Replace(strF(24), Chr(34), "") ' test0 = Replace(strF(23), Chr(34), "") If test0 <> "" And test0 <> "0.00" Then ' If test0 = "HDR10" Then ' strINVOICE = Replace(strF(5), Chr(34), "") Line Input #1, strLINE2 strG = Split(strLINE2, ",") ' ElseIf test0 = "DTL10" Then ' dblQTY = Field2Str2(strG(28)) dblQTY = Replace(strG(28), Chr(34), "") '''' dblQTY = Replace(strG(29), Chr(34), "") '' If lngQTY > 0 Then ' strCELL = Replace(strF(3), Chr(34), "") ' strSTOCK = Mid$(strCELL, 1, 12) ' strDESC = Mid$(strCELL, 16, 30) ' strSTOCK = Replace(strF(2), Chr(34), "") ' strSTOCK = Replace(strG(24), Chr(34), "") strSTOCK = test0 'Replace(strG(24), Chr(34), "") strASTRICK = Right(strSTOCK, 2) If strASTRICK = "**" Then bytLEN3 = Len(strSTOCK) strSTOCK = Left(strSTOCK, (bytLEN3 - 2)) strSTOCK = RTrim(strSTOCK) End If strDESC = Replace(strG(26), Chr(34), "") '''' strDESC = Replace(strG(27), Chr(34), "") strINVOICE = Replace(strG(9), Chr(34), "") dblCost = Replace(strG(36), Chr(34), "") ' dblCost = CDbl(Field2Str2(strG(36))) oRS.AddNew oRS!VStock = strSTOCK oRS!VDesc = strDESC 'Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) oRS!Order = dblQTY 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(dblQTY) oRS!Cost = dblCost 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then oRS!VENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then oRS!VENDOR = "PURIMIL" End If oRS!Description = " " oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!InvDate = mstrDATE oRS!Invoice = strINVOICE oRS.Update ElseIf dblQTY = 0 Then End If End If Loop oRS.Close Close (1) mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "PURIMIL" End If Call GetStock Call PURPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" Screen.MousePointer = 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module mnuPurina2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuPurina1_Click() Dim intRow As Integer, boolSTOP As Boolean, intLINENO As Integer Dim strLOCATE As String, strCHECK As String 'Dim strSTONE As String, strDESC As String, dblPRICE As Double Dim dblCost As Double, lngQTY As Long, strSTOCK As String, strDESC As String Dim oRS As Recordset, strSTK_DESC As String Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim strTYPE As String, strINVOICE As String, strCELL As String Dim boolCHECK As Boolean, intCHECK As Integer 'Dim strF1 As String, strF2 As String, strF3 As String, strF4 As String, strF5 As String 'Dim strF6 As String, strF7 As String, strF8 As String, strF9 As String, strF10 As String 'Dim strF11 As String, strF12 As String, strF13 As String, strF14 As String, strF15 As String Dim strF() As String, strDiscCost As String, dblDCost As Double Dim strLine As String, strNET As String, strFIND As String Dim strSQLL As String, oRSS As Recordset, strNetCost As String Dim bytLEN As Byte, bytLEN2 As Byte, bytLEN3 As Byte, strASTRICK As String Screen.MousePointer = vbHourglass On Error GoTo Error_EH intLINENO = 1 boolSTOP = False boolCHECK = False intCHECK = 0 cdPO.Action = 1 strLOCATE = cdPO.FileName mstrDATE = InputBox("Enter The Purina Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intRow = 1 Open strLOCATE For Input As #1 Do Until EOF(1) Line Input #1, strLine If Trim$(strLine) <> "" Then strF = Split(strLine, ",") test0 = Replace(strF(0), Chr(34), "") If test0 = "HDR10" Then strINVOICE = Replace(strF(5), Chr(34), "") ElseIf test0 = "DTL10" Then lngQTY = Field2Str2(strF(4)) If lngQTY > 0 Then ' strCELL = Replace(strF(3), Chr(34), "") ' strSTOCK = Mid$(strCELL, 1, 12) ' strDESC = Mid$(strCELL, 16, 30) ' strSTOCK = Replace(strF(2), Chr(34), "") strSTOCK = Replace(strF(2), Chr(34), "") strASTRICK = Right(strSTOCK, 2) If strASTRICK = "**" Then bytLEN3 = Len(strSTOCK) strSTOCK = Left(strSTOCK, (bytLEN3 - 2)) strSTOCK = RTrim(strSTOCK) End If strDESC = Replace(strF(3), Chr(34), "") dblCost = Field2Str2(strF(5)) oRS.AddNew oRS!VStock = strSTOCK oRS!VDesc = strDESC 'Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) oRS!Order = lngQTY 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(lngQTY) oRS!Cost = dblCost 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then oRS!VENDOR = "PUR500" ' oRS!VENDOR = "PURIMIL" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then oRS!VENDOR = "PURIMIL" End If oRS!Description = " " oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!InvDate = mstrDATE oRS!Invoice = strINVOICE oRS.Update ElseIf lngQTY = 0 Then strSQLL = "SELECT * FROM tblCPImport WHERE VStock = '" & strSTOCK & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic ' strFIND = "VStock = '" & strSTOCK & "'" ' oRS.MoveFirst ' oRS.Find strFIND ' oRS.MoveLast ' strSTOCK = oRS!vstock If Not oRSS.EOF Then strDiscCost = Replace(strF(3), Chr(34), "") strNET = Mid$(strDiscCost, 1, 8) If strNET = "Net Cost" Then ' strNetCost = Mid$(strDiscCost, 1, 8) bytLEN = Len(strDiscCost) bytLEN2 = bytLEN - 8 dblDCost = Field2Str2(Right$(strDiscCost, bytLEN2)) ' dblDCost = Field2Str2(Right$(strDiscCost, 10)) oRSS!Cost = Round(dblDCost, 4) ' oRS.Save oRSS.Update End If End If End If End If End If Loop oRS.Close Close (1) mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "PUR500" ' mstrVENDOR = "PURIMIL" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "PURIMIL" End If Call GetStock Call PURPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" Screen.MousePointer = 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module mnuPurina" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuPurina0126_Click() Dim intRow As Integer, boolSTOP As Boolean, intLINENO As Integer Dim strLOCATE As String, strCHECK As String 'Dim strSTONE As String, strDESC As String, dblPRICE As Double Dim dblCost As Double, lngQTY As Long, strSTOCK As String, strDESC As String Dim oRS As Recordset, strSTK_DESC As String Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim strTYPE As String, strINVOICE As String, strCELL As String Dim boolCHECK As Boolean, intCHECK As Integer 'Dim strF1 As String, strF2 As String, strF3 As String, strF4 As String, strF5 As String 'Dim strF6 As String, strF7 As String, strF8 As String, strF9 As String, strF10 As String 'Dim strF11 As String, strF12 As String, strF13 As String, strF14 As String, strF15 As String Dim strF() As String, strDiscCost As String, dblDCost As Double Dim strLine As String, strNET As String, strFIND As String Dim strSQLL As String, oRSS As Recordset Screen.MousePointer = vbHourglass On Error GoTo Error_EH intLINENO = 1 boolSTOP = False boolCHECK = False intCHECK = 0 cdPO.Action = 1 strLOCATE = cdPO.FileName mstrDATE = InputBox("Enter The Purina Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intRow = 1 Open strLOCATE For Input As #1 Do Until EOF(1) Line Input #1, strLine If Trim$(strLine) <> "" Then strF = Split(strLine, ",") test0 = Replace(strF(0), Chr(34), "") If test0 = "HDR10" Then strINVOICE = Replace(strF(5), Chr(34), "") ElseIf test0 = "DTL10" Then lngQTY = Field2Str2(strF(4)) If lngQTY > 0 Then strCELL = Replace(strF(3), Chr(34), "") strSTOCK = Mid$(strCELL, 1, 12) strDESC = Mid$(strCELL, 16, 30) ' strSTOCK = Replace(strF(2), Chr(34), "") ' strDESC = Replace(strF(3), Chr(34), "") dblCost = Field2Str2(strF(5)) oRS.AddNew oRS!VStock = strSTOCK oRS!VDesc = strDESC 'Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) oRS!Order = lngQTY 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mdblQORDER = Field2Str2(lngQTY) oRS!Cost = dblCost 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then oRS!VENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then oRS!VENDOR = "PURIMIL" End If oRS!Description = " " oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!InvDate = mstrDATE oRS!Invoice = strINVOICE oRS.Update ElseIf lngQTY = 0 Then strSQLL = "SELECT * FROM tblCPImport WHERE VStock = '" & strSTOCK & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic ' strFIND = "VStock = '" & strSTOCK & "'" ' oRS.MoveFirst ' oRS.Find strFIND ' oRS.MoveLast ' strSTOCK = oRS!vstock If Not oRSS.EOF Then strDiscCost = Replace(strF(3), Chr(34), "") strNET = Mid$(strDiscCost, 1, 8) If strNET = "Net Cost" Then dblDCost = Field2Str2(Right$(strDiscCost, 13)) oRSS!Cost = Round(dblDCost, 4) ' oRS.Save oRSS.Update End If End If End If End If End If Loop oRS.Close Close (1) mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "PURIMIL" End If Call GetStock Call PURPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" Screen.MousePointer = 0 Exit Sub Error_EH: gstrMODULE = "Form POOpen - Module ImportPurina" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub PurninaHold() Dim intRow As Integer, boolSTOP As Boolean, intLINENO As Integer Dim strLOCATE As String, strCHECK As String 'Dim strSTONE As String, strDESC As String, dblPRICE As Double Dim dblCost As Double, lngQTY As Long, strSTOCK As String, strDESC As String Dim oRS As Recordset, strSTK_DESC As String Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim strTYPE As String, strINVOICE As String, strCELL As String Dim boolCHECK As Boolean, intCHECK As Integer Screen.MousePointer = vbHourglass On Error GoTo Error_EH intLINENO = 1 boolSTOP = False boolCHECK = False intCHECK = 0 If ExcelOpen() Then ' Add New WorkBook cdPO.Action = 1 strLOCATE = cdPO.FileName mstrDATE = InputBox("Enter The Purina Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If ' strLOCATE = App.Path goExcel.Workbooks.Open (strLOCATE) ' & "\JHDPrice.xls") ' Get currently active sheet object With goExcel.ActiveSheet ' Open Database ' Build SQL Statement strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If oRS.EOF Then End If ' Load data into Excel intRow = 1 Do Until boolCHECK ' Do Until strCHECK = "TLR10" ' Do Until boolSTOP strTYPE = Trim$(.Cells(intRow, 1).Value) If strTYPE = "HDR10" Then strINVOICE = Trim$(.Cells(intRow, 6).Value) ' intRow = intRow + 1 ElseIf strTYPE = "DTL10" Then lngQTY = Round((.Cells(intRow, 5).Value), 0) If lngQTY > 0 Then strCELL = Trim$(.Cells(intRow, 4).Value) strSTOCK = Mid$(strCELL, 1, 14) strDESC = Mid$(strCELL, 16, 30) dblCost = Round((.Cells(intRow, 6).Value), 4) oRS.AddNew oRS!VStock = strSTOCK oRS!VDesc = strDESC 'Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) oRS!Order = lngQTY 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!Cost = dblCost 'Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) oRS!lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then oRS!VENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then oRS!VENDOR = "PURIMIL" End If oRS!Description = " " oRS!Type = "" oRS!LastCost = 0 oRS!Retail1 = 0 oRS!InvDate = mstrDATE oRS!Invoice = strINVOICE oRS.Update End If End If intRow = intRow + 1 strCHECK = .Cells(intRow, 1).Value If strCHECK = "TLR10" Then intCHECK = 1 End If If strCHECK = "" And intCHECK = 1 Then intCHECK = 2 ElseIf strCHECK = "" And intCHECK = 2 Then boolCHECK = True ElseIf strCHECK = "HDR10" And intCHECK = 2 Then intCHECK = 0 End If Loop End With oRS.Close End If goExcel.Quit mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "PUR500" ElseIf gstrCOMPANY = "AFN" Or gstrCOMPANY = "AFS" Then mstrVENDOR = "PURIMIL" End If Call GetStock Call PURPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Exit Sub Error_EH: gstrMODULE = "Form POOpen - Module ImportPurina" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuReports_Click() Call cmdReports_Click End Sub Private Sub mnuThomp2_Click() Dim strVSTOCK As String, strSTOCK As String, strVDESC As String Dim strQTY As String, strCOST As String, strINVNO As String Dim strINPUT As String, strSQL As String, strFILE As String Dim strFLAG As String, intAUX As Integer, strTEST As String Dim strSQLL As String, intTAB As Integer, intSTART As Integer, intOLD As Integer Dim intLINENO As Integer 'Import data from e-mailed file into table for subsiquent import into PO table 'Need pricing report for this to be useful On Error GoTo Error_EH ' strSQL = "DELETE * FROM " & mstrTABLE 'tblCPImport" strSQL = "DELETE * FROM tblCPImport" goConn.Execute strSQL cdPO.Action = 1 strFILE = cdPO.FileName mstrDATE = InputBox("Enter The Thompson Vet Invoice Date MM/DD/YYYY", "Invoice Date", Date) If IsDate(mstrDATE) Then Else If Len(mstrDATE) > 0 Then mstrDATE = Format(mstrDATE, "00/00/####") If Not IsDate(mstrDATE) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub End If End If End If MousePointer = 11 ' strSQL = "SELECT * FROM " & mstrTABLE 'tblCPImport" strSQL = "SELECT * FROM tblCPImport ORDER By LineNo" Set moRSInv = New Recordset moRSInv.Open strSQL, goConn, adOpenKeyset, adLockOptimistic intLINENO = 1 Open strFILE For Input As #1 Do Until EOF(1) Line Input #1, strINPUT If Not Mid(strINPUT, 1, 6) = "VENDOR" Then intSTART = 1 With moRSInv intAUX = 0 .AddNew intTAB = InStr(intSTART, strINPUT, Chr(9)) !VStock = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) intSTART = intSTART + intTAB intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !inv_no = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB)))) ' !Inv_No = Field2Str(Mid(strINPUT, 11, 7)) intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !VDesc = Field2Str(Trim$(Mid(strINPUT, intSTART, (intTAB - 1)))) ' !VDesc = "" intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Order = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) ' !Order = "" intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Cost = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) ' !Cost = "" intSTART = intSTART + intTAB + 1 intOLD = intTAB intTAB = (InStr(intSTART, strINPUT, Chr(9))) - intSTART !Invoice = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) mstrCP_PO = Field2Str2(Trim$(Mid(strINPUT, intSTART, (intTAB)))) ' !Invoice = "" !lineno = intLINENO intLINENO = intLINENO + 1 If gstrCOMPANY = "TSS" Then !VENDOR = "THO500" Else !VENDOR = "THOMVET" End If ' !VENDOR = "THO500" !Description = " " !Type = "" !LastCost = 0 !Retail1 = 0 !InvDate = mstrDATE .Update End With End If Loop moRSInv.Close Close #1 mstrTABLE = "tblCPImport" If gstrCOMPANY = "TSS" Then mstrVENDOR = "THO500" Else mstrVENDOR = "THOMVET" End If ' mstrVENDOR = "THO500" Call GetStock Call CPPO MsgBox "Import of Invoice Information Complete", vbInformation + vbOKOnly, "Import Done" MousePointer = 0 Exit Sub Error_EH: If Err = cdlCancel Then MsgBox "The Import Was Canceled", vbCritical + vbOKOnly, "Cancel" Exit Sub End If gstrMODULE = "Form Main - Module mnuThomp" Call ErrorHandler2 gstrMODULE = "" End Sub Private Sub mnuUpVendor_Click() Call cmdUpVendor_Click End Sub Private Sub txtBegSelect_GotFocus() txtBegSelect.SelStart = 0 txtBegSelect.SelLength = 1000 End Sub Private Sub txtEndSelect_GotFocus() txtEndSelect.SelStart = 0 txtEndSelect.SelLength = 1000 End Sub Private Sub txtOrderQty_Click() txtOrderQty.SelStart = 0 txtOrderQty.SelLength = 100 txtOrderQty.SetFocus End Sub Private Sub txtOrderQty_GotFocus() txtOrderQty.SelStart = 0 txtOrderQty.SelLength = 100 End Sub Private Sub txtOrderQty_KeyPress(KeyAscii As Integer) Dim intBookmark As Integer If KeyAscii = vbKeyReturn Then ' MsgBox "THis is a test" If txtOrderQty <> lblOrderHold Then intBookmark = lstProcess.ListIndex If IsNumeric(txtOrderQty) Then moRSUpdate!Order = (txtOrderQty) Else MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid Number" moRSUpdate!Order = 0 txtOrderQty.SetFocus Exit Sub ' moRSUpdate!Order = 0 End If moRSUpdate.Update txtOrderQty = "" lblOrderHold = "" Call Inventory2Load If mintBOOKMARK2 >= lstProcess.ListCount - 1 Then intBookmark = lstProcess.ListCount - 1 Else intBookmark = intBookmark + 1 End If lstProcess.ListIndex = intBookmark ' txtOrderQty.SetFocus Call txtOrderQty_Click Exit Sub Else lstProcess.ListIndex = lstProcess.ListIndex + 1 ' txtOrderQty.SetFocus Call txtOrderQty_Click Exit Sub End If End If ' txtOrderQty.SetFocus End Sub Private Sub txtSearch_Change() 'Multiple character search code. lstInventory.SearchText = txtSearch.Text lstInventory.SearchMethod = 2 lstInventory.Action = ActionSearch lstInventory.SearchIndex = -1 lstInventory.Action = 0 If lstInventory.SearchIndex <> -1 Then lstInventory.TopIndex = lstInventory.SearchIndex lstInventory.ListIndex = lstInventory.SearchIndex Else lstInventory.Action = 6 ' clear End If End Sub Private Sub txtSearch_GotFocus() txtSearch.SelStart = 0 txtSearch.SelLength = 1000 End Sub Private Sub POCreate() Dim strVENDOR As String, strSQL As String Dim oRS As Recordset, lngNextPO As Long, lngPOLineNum As Long Dim lngPOID As Long, strOrderDate As String, strDueDate As String 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngAdd1 As Long Dim lngAdd2 As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long, lngSTOCK As Long, lngONORDER As Long Dim lngTTLWEIGHT As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strAdd2 As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String, dblCALCONORDER As Double Dim dblQTY As Double, dblPRICE As Double, strDOC As String, strSTOCK As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double, dblONORDER As Double Dim lngONHAND As Long, dblONHAND As Double, strBUYER As String Dim dblEXT As Double, dblQORDER As Double, dblQCost As Double, strONHAND As String Dim lngDueCtl As Long, lngDueDay As Long, lngDisCtl As Long, lngDisDay As Long Dim lngDUECTL2 As Long, lngDUEDAY2 As Long, lngDISCTL2 As Long, lngDISDAY2 As Long Dim lngAPCODE As Long, strAPCODE As String, intYNNote As Integer 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long, lngPOS As Long Dim strYEAR As String, strMONTH2 As String, strDAY As String, strDATE As String Dim lngODATE As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH intYNNote = vbNo strYEAR = Year(Date) strMONTH2 = Format(Month(Date), "00") strDAY = Format(Day(Date), "00") strDATE = strYEAR & strMONTH2 & strDAY gstrMODULE = "Before frmVendor.Show" lngTTLWEIGHT = 0 mintYN = vbYes ' frmVendorLook.Show 1 ' frmVendor.Show 1 If gstrVENDOR = "" Then MsgBox "No Vendor Selected", vbCritical + vbOKOnly, "No PO Created" mintYN = vbNo Exit Sub End If ' On Error GoTo Error_EH strOrderDate = InputBox("Enter The PO Order Date", "PO Order Date", Date) gstrMODULE = "Point 1 " If IsDate(strOrderDate) Then Else ' lngPOS = InStr(1, strOrderDate, "/", 1) ' If lngPOS = 0 Then If Len(strOrderDate) > 0 Then strOrderDate = Format(strOrderDate, "00/00/####") If Not IsDate(strOrderDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub lblSelectVend.Visible = False cboVendor.Visible = False lblBegSelect.Visible = True lblEndSelect.Visible = True txtEndSelect.Visible = True txtBegSelect.Visible = True txtBegDate.Visible = True txtEndDate.Visible = True lblBegDate.Visible = True lblEndDate.Visible = True End If End If End If strDueDate = InputBox("Enter the Due Date for the PO", "PO Due Date", (Date + 1)) If IsDate(strDueDate) Then Else If Len(strDueDate) > 0 Then strDueDate = Format(strDueDate, "00/00/####") If Not IsDate(strDueDate) Then MsgBox "The Date You Entered is not Valid - ReEnter", vbCritical + vbOKOnly, "InValid Date" Exit Sub lblSelectVend.Visible = False cboVendor.Visible = False lblBegSelect.Visible = True lblEndSelect.Visible = True txtEndSelect.Visible = True txtBegSelect.Visible = True txtBegDate.Visible = True txtEndDate.Visible = True lblBegDate.Visible = True lblEndDate.Visible = True End If End If End If strBUYER = InputBox("Enter The Name Of The Person Creating The PO", "Buyer's Name", "This is Required") If strBUYER = "This is Required" Or Trim$(strBUYER) = "" Then MsgBox "You have entered an invalid Buyer -- NO PO WILL BE CREATED", vbCritical + vbOKOnly mintYN = vbNo lblSelectVend.Visible = False cboVendor.Visible = False lblBegSelect.Visible = True lblEndSelect.Visible = True txtEndSelect.Visible = True txtBegSelect.Visible = True txtBegDate.Visible = True txtEndDate.Visible = True lblBegDate.Visible = True lblEndDate.Visible = True Exit Sub Else intYNNote = MsgBox("Do You Want To Add Notes To This PO?", vbYesNo + vbDefaultButton2, "Add Notes?") End If strBUYER = UCase(strBUYER) gstrMODULE = "Point 2 " cb = code4init lngPOLineNum = 1 strSQL = "Select * FROM tblProgInfo" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = Field2Str2(oRS!NextPO) glngPO = lngNextPO oRS!NextPO = lngNextPO + 1 oRS.Update strVENDOR = gstrVENDOR strSQL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQL, goConn, adOpenKeyset, adLockOptimistic '******* strSQL = gstrCOMPANY & "APMSD" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "AP_VENDOR") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, strVENDOR) gstrMODULE = "Point 3 " oSTATUS = d4deleted(db) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngVEND = d4field(db, "AP_VENDOR") lngNAME = d4field(db, "AP_NAME") lngAdd1 = d4field(db, "AP_ADDR1") lngAdd2 = d4field(db, "AP_ADDR2") lngCITY = d4field(db, "AP_CITY") lngState = d4field(db, "AP_STATE") lngZIP = d4field(db, "AP_ZIP") lngPHONE = d4field(db, "AP_PHONE") lngFAX = d4field(db, "AP_FAX") lngAPCODE = d4field(db, "AP_CODE") lngDueCtl = d4field(db, "AP_DUECTL") lngDisCtl = d4field(db, "AP_DISCTL") lngDueDay = d4field(db, "AP_DUEDAY") lngDisDay = d4field(db, "AP_DISDAY") strVEND = Field2Str(f4str(lngVEND)) strNAME = f4str(lngNAME) strAdd1 = f4str(lngAdd1) strAdd2 = f4str(lngAdd2) strCITY = f4str(lngCITY) strState = f4str(lngState) strZIP = f4str(lngZIP) strPHONE = f4str(lngPHONE) strFAX = f4str(lngFAX) strAPCODE = f4str(lngAPCODE) lngDUECTL2 = f4long(lngDueCtl) lngDISCTL2 = f4long(lngDisCtl) lngDUEDAY2 = f4long(lngDueDay) lngDISDAY2 = f4long(lngDisDay) moRSPOHeader.AddNew moRSPOHeader!ponum = lngNextPO ' moRSPOHeader!VendorID = Trim(gstrVENDOR) moRSPOHeader!vendorid = Trim(strVEND) moRSPOHeader!vendorname = Trim(strNAME) moRSPOHeader!vaddress1 = Trim(strAdd1) moRSPOHeader!vaddress2 = Trim(strAdd2) moRSPOHeader!vcity = Trim(strCITY) moRSPOHeader!vstate = Trim(strState) moRSPOHeader!vzip = Trim(strZIP) moRSPOHeader!VPhone = Trim(strPHONE) moRSPOHeader!VFAX = Trim(strFAX) moRSPOHeader!OrderDate = strOrderDate moRSPOHeader!DueDate = strDueDate moRSPOHeader!Buyer = strBUYER moRSPOHeader!duectl = lngDUECTL2 moRSPOHeader!disctl = lngDISCTL2 moRSPOHeader!dueday = lngDUEDAY2 moRSPOHeader!disday = lngDISDAY2 moRSPOHeader!CreateID = gstrLOGIN If Trim(strAPCODE) = "ACC" Then moRSPOHeader!CCard = vbChecked Else moRSPOHeader!CCard = vbUnchecked End If moRSPOHeader.Update End If '' End If rc = d4close(db) strSQL = "SELECT * FROM tblPOHeader WHERE PONUM = " & lngNextPO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid mstrAVENDOR = moRSPOHeader!vendorid strSQL = "SELECT * FROM tblPODetail" Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblPOLIST WHERE User = '" & gstrLOGIN & "' " & " ORDER BY ListID" ' strSQL = "SELECT * FROM tblPOLIST SORTedBY ListID WHERE User = '" & gstrLOGIN & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst gstrMODULE = "Point 4 " Do Until oRS.EOF '************** mstrSTOCK = Trim(oRS!inv_no) strSQL = gstrCOMPANY & "INMAS" gstrMODULE = "Point 5 " db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") gstrMODULE = "Point 5.1 " Call d4tagSelect(db, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) gstrMODULE = "Point 5.2 " '*************** This may be good logic to keep the on order amounts correct ' mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngONORDER = d4field(db, "IN_ORDERTE") lngODATE = d4field(db, "IN_LSORDR") gstrMODULE = "Point 5.3 " gstrMODULE = "mstrSTOCK = " & mstrSTOCK gstrMODULE = gstrMODULE & " Make Sure On Order is Zero" strONORDER = f4str(lngONORDER) strONORDER = Field2Str2(strONORDER) dblONORDER = CDbl(strONORDER) ' dblONORDER = f4str(lngONORDER) gstrMODULE = "dblONORDER = " & dblONORDER dblQORDER = Field2Str2(oRS!Order) gstrMODULE = "dblQORDER = " & dblQORDER dblCALCONORDER = dblONORDER + dblQORDER gstrMODULE = "dblCALCONORDER = " & dblCALCONORDER Call f4assignDouble(lngONORDER, dblCALCONORDER) ' Call f4assignDateTime(lngODATE, strDATE) Call f4assign(lngODATE, strDATE) gstrMODULE = "Point 5.4 " End If gstrMODULE = "Point 6 " rc = d4close(db) strSQL = gstrCOMPANY & "INMAT" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INMXSTOCK3") gstrMODULE = "Point 5.1 " Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) gstrMODULE = "Point 5.2 " '*************** This may be good logic to keep the on order amounts correct ' mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngONORDER = d4field(db, "INMXONORDR") lngODATE = d4field(db, "INMXLSORDR") gstrMODULE = "Point 5.3 " gstrMODULE = "mstrSTOCK = " & mstrSTOCK gstrMODULE = gstrMODULE & " Make Sure On Order is Zero" strONORDER = f4str(lngONORDER) strONORDER = Field2Str2(strONORDER) dblONORDER = CDbl(strONORDER) ' dblONORDER = f4str(lngONORDER) gstrMODULE = "dblONORDER = " & dblONORDER dblQORDER = Field2Str2(oRS!Order) gstrMODULE = "dblQORDER = " & dblQORDER dblCALCONORDER = dblONORDER + dblQORDER gstrMODULE = "dblCALCONORDER = " & dblCALCONORDER Call f4assignDouble(lngONORDER, dblCALCONORDER) ' Call f4assignDateTime(lngODATE, strDATE) Call f4assign(lngODATE, strDATE) gstrMODULE = "Point 5.4 " End If gstrMODULE = "Point 6 " rc = d4close(db) '************** dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) If Field2Str2(oRS!Order) > 0 Then moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!lineno = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(oRS!inv_no) ' mstrSTOCK = Trim(oRS!Inv_No) ' If oRS!new = 1 Then If oRS!New = True Then moRSPODetail!vstockno = Field2Str(oRS!VStock) ElseIf Len(Field2Str(oRS!VStock)) > 0 Then '***** This may need to be removed if it causes PO to not have a vendor stock number moRSPODetail!vstockno = Field2Str(oRS!VStock) Else Call GETAVINFO mstrADDVStock = Trim(mstrVSTOCK) If Len(mstrADDVStock) = 20 Then mstrADDVStock = "" End If moRSPODetail!vstockno = mstrADDVStock End If ' If Len(mstrADDVStock) = 20 Then ' mstrADDVStock = "" ' End If ' moRSPODetail!vstockno = mstrADDVStock moRSPODetail!Desc = Trim(oRS!Description) moRSPODetail!BalQty = Field2Str2(oRS!Order) moRSPODetail!Qty = Field2Str2(oRS!Order) moRSPODetail!Cost = Field2Str2(oRS!LastCost) moRSPODetail!LastCost = Field2Str2(oRS!LastCost) moRSPODetail!Retail1 = Field2Str2(oRS!Retail1) moRSPODetail!Weight = Field2Str2(oRS!Weight) moRSPODetail!Min = Field2Str2(oRS!Min) moRSPODetail!Max = Field2Str2(oRS!Max) moRSPODetail!ExtCost = dblEXT moRSPODetail!Type = 5 moRSPODetail!Add = oRS!New ' moRSPODetail!Available = dblONORDER moRSPODetail!CreateID = gstrLOGIN moRSPODetail!PVendor = Field2Str(oRS!VENDOR) moRSPODetail!StdCost = Field2Str2(oRS!StdCost) moRSPODetail.Update lngTTLWEIGHT = lngTTLWEIGHT + (Field2Str2(oRS!Order) * Field2Str2(oRS!Weight)) End If oRS.MoveNext gstrMODULE = "Point 7 " Loop If intYNNote = vbYes Then gboolNoteADD = True frmPONotes.Show 1 End If If glngPONID > 0 Then moRSPOHeader!PONoteFlag = vbChecked moRSPOHeader!PONID = glngPONID moRSPOHeader.Update End If gstrMODULE = "Point 8 " moRSPOHeader!TTLWEIGHT = lngTTLWEIGHT moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update Exit Sub Error_EH: gstrMODULE = "Form PO - Module POCreate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CPPO() Dim strSQL As String, oRS As Recordset Dim strSQLL As String, oRSS As Recordset Dim dblQORDER As Double, dblQCost As Double, dblEXT As Double Dim lngPOLineNum As Long, lngPOID As Long Dim strINVOICE As String, strTEST As String On Error GoTo Error_EH GoSub Set_Header strSQL = "SELECT * FROM tblPODetail" Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblCPImport ORDER By LineNo" ' strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst mstrCP_PO = oRS!Invoice Do Until oRS.EOF strINVOICE = oRS!Invoice If strINVOICE <> mstrCP_PO Then mstrCP_PO = strINVOICE If lngPOLineNum <> 0 Then moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update End If GoSub Set_Header End If dblBUYCON = Field2Str(oRS!buycon) If dblBUYCON > 0 Then dblQORDER = Field2Str2(oRS!Order) dblQORDER = dblQORDER * dblBUYCON dblQCost = Field2Str2(oRS!Cost) dblQCost = dblQCost / dblBUYCON dblQCost = Format(dblQCost, "#,#.0000") dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) Else dblQORDER = Field2Str2(oRS!Order) dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) End If moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!lineno = lngPOLineNum moRSPODetail!InvLine = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(oRS!inv_no) mstrSTOCK = UCase(Trim(Field2Str(oRS!inv_no))) ' Call GETAVINFO moRSPODetail!vstockno = oRS!VStock strTEST = Left(Trim(oRS!Description), 4) moRSPODetail!Desc = Trim(oRS!Description) ' moRSPODetail!balqty = oRS!Order moRSPODetail!Qty = oRS!Order mdblQORDER = dblQORDER ' mdblQORDER = Field2Str2(oRS!Order) moRSPODetail!Cost = dblQCost ' moRSPODetail!Cost = oRS!Cost ' moRSPODetail!actcost = oRS!Cost moRSPODetail!ActCost = dblQCost moRSPODetail!ActCostO = dblQCost moRSPODetail!LastCost = oRS!LastCost moRSPODetail!Retail1 = oRS!Retail1 moRSPODetail!ExtCost = dblEXT ' moRSPODetail!ExtCost = dblEXT moRSPODetail!AExtCost = dblEXT moRSPODetail!NRetail = oRS!Retail1 ' moRSPODetail!ACTQty = oRS!Order moRSPODetail!BalQty = oRS!Order - moRSPODetail!ACTQty ' moRSPODetail!BalQty = oRS!Order - moRSPODetail!qty moRSPODetail!Type = 5 moRSPODetail!NRetail = oRS!Retail1 moRSPODetail!ACTQty = dblQORDER If strTEST = "****" Then moRSPODetail!Add = vbChecked Else moRSPODetail!Add = oRS!Add End If ' moRSPODetail!Add = oRS!Add moRSPODetail!Weight = Field2Str2(oRS!Weight) moRSPODetail!PVendor = Field2Str(oRS!PVendor) moRSPODetail.Update oRS.MoveNext Call UpONOrder Loop moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update lngPOLineNum = 0 Exit Sub Set_Header: lngPOLineNum = 1 strSQLL = "Select * FROM tblProgInfo" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = oRSS!NextPO glngPO = lngNextPO oRSS!NextPO = lngNextPO + 1 oRSS.Update strSQLL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If mstrVENDOR = "THO500" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "THO500" moRSPOHeader!vendorname = "Thompson Veterinary Supply" moRSPOHeader!vaddress1 = "1340 N. 29TH AVE." moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "PHOENIX" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85009" moRSPOHeader!VPhone = "(602) 258-8187" moRSPOHeader!VFAX = "(602) 278-1512" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "MARK" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update ElseIf mstrVENDOR = "THOMVET" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "THOMVET" moRSPOHeader!vendorname = "Thompson Veterinary Supply" moRSPOHeader!vaddress1 = "1340 N. 29TH AVE." moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "PHOENIX" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85009" moRSPOHeader!VPhone = "(602) 258-8187" moRSPOHeader!VFAX = "(602) 278-1512" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "KEVIN" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update ElseIf mstrVENDOR = "CEN500" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "CEN500" moRSPOHeader!vendorname = "Central Pet West" moRSPOHeader!vaddress1 = "13227 Orden Drive" moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "Santa Fe Springs" moRSPOHeader!vstate = "CA" moRSPOHeader!vzip = "90670" moRSPOHeader!VPhone = "800 283-4738" moRSPOHeader!VFAX = "480 785-1243" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "JOE" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update ElseIf mstrVENDOR = "CENTPET" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "CENTPET" moRSPOHeader!vendorname = "Central Pet West" moRSPOHeader!vaddress1 = "13227 Orden Drive" moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "Santa Fe Springs" moRSPOHeader!vstate = "CA" moRSPOHeader!vzip = "90670" moRSPOHeader!VPhone = "800 283-4738" moRSPOHeader!VFAX = "480 785-1243" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "ERIC" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update End If strSQLL = "SELECT * FROM tblPOHeader WHERE PONUM = " & glngPO ' strSQL = "SELECT * FROM tblPOHeader WHERE PONUM = " & mstrCP_PO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid Return Error_EH: gstrMODULE = "Form PO - Module CPPO_Create" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub TVPO() Dim strSQL As String, oRS As Recordset, strTEST As String Dim strSQLL As String, oRSS As Recordset Dim dblQORDER As Double, dblQCost As Double, dblEXT As Double Dim lngPOLineNum As Long, lngPOID As Long Dim strINVOICE As String On Error GoTo Error_EH ' GoSub Set_Header strSQL = "SELECT * FROM tblPODetail" Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblCPImport ORDER By LineNo" ' strSQL = "SELECT * FROM tblCPImport" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst strTEST = Field2Str(oRS!VENDOR) mstrCP_PO = oRS!Invoice GoSub Set_Header Do Until oRS.EOF strINVOICE = oRS!Invoice If strINVOICE <> mstrCP_PO Then mstrCP_PO = strINVOICE If lngPOLineNum <> 0 Then moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update End If GoSub Set_Header End If dblBUYCON = Field2Str(oRS!buycon) If dblBUYCON > 0 Then dblQORDER = Field2Str2(oRS!Order) dblQORDER = dblQORDER * dblBUYCON dblQCost = Field2Str2(oRS!Cost) dblQCost = dblQCost / dblBUYCON dblQCost = Format(dblQCost, "#,#.0000") dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) Else dblQORDER = Field2Str2(oRS!Order) dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) End If moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!lineno = lngPOLineNum moRSPODetail!InvLine = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(oRS!inv_no) mstrSTOCK = UCase(Trim(Field2Str(oRS!inv_no))) ' Call GETAVINFO moRSPODetail!vstockno = oRS!VStock strTEST = Left(Trim(oRS!Description), 4) moRSPODetail!Desc = Trim(oRS!Description) ' moRSPODetail!balqty = oRS!Order moRSPODetail!Qty = oRS!Order mdblQORDER = dblQORDER ' mdblQORDER = Field2Str2(oRS!Order) moRSPODetail!Cost = dblQCost ' moRSPODetail!Cost = oRS!Cost ' moRSPODetail!actcost = oRS!Cost moRSPODetail!ActCost = dblQCost moRSPODetail!ActCostO = dblQCost moRSPODetail!LastCost = oRS!LastCost moRSPODetail!Retail1 = oRS!Retail1 moRSPODetail!ExtCost = dblEXT ' moRSPODetail!ExtCost = dblEXT moRSPODetail!AExtCost = dblEXT moRSPODetail!NRetail = oRS!Retail1 ' moRSPODetail!ACTQty = oRS!Order moRSPODetail!BalQty = oRS!Order - moRSPODetail!ACTQty ' moRSPODetail!BalQty = oRS!Order - moRSPODetail!qty moRSPODetail!Type = 5 moRSPODetail!NRetail = oRS!Retail1 moRSPODetail!ACTQty = dblQORDER If strTEST = "****" Then moRSPODetail!Add = vbChecked Else moRSPODetail!Add = oRS!Add End If ' moRSPODetail!Add = oRS!Add moRSPODetail!Weight = Field2Str2(oRS!Weight) moRSPODetail.Update oRS.MoveNext Call UpONOrder Loop moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update lngPOLineNum = 0 Exit Sub Set_Header: lngPOLineNum = 1 strSQLL = "Select * FROM tblProgInfo" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = oRSS!NextPO glngPO = lngNextPO oRSS!NextPO = lngNextPO + 1 oRSS.Update strSQLL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If mstrVENDOR = "THO500" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "THO500" moRSPOHeader!vendorname = "Thompson Veterinary Supply" moRSPOHeader!vaddress1 = "1340 N. 29TH AVE." moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "PHOENIX" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85009" moRSPOHeader!VPhone = "(602) 258-8187" moRSPOHeader!VFAX = "(602) 278-1512" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "MARK" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update ElseIf mstrVENDOR = "THOMVET" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "THOMVET" moRSPOHeader!vendorname = "Thompson Veterinary Supply" moRSPOHeader!vaddress1 = "1340 N. 29TH AVE." moRSPOHeader!vaddress2 = "" moRSPOHeader!vcity = "PHOENIX" moRSPOHeader!vstate = "AZ" moRSPOHeader!vzip = "85009" moRSPOHeader!VPhone = "(602) 258-8187" moRSPOHeader!VFAX = "(602) 278-1512" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "KEVIN" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 30 moRSPOHeader.Update End If strSQLL = "SELECT * FROM tblPOHeader WHERE PONUM = " & glngPO ' strSQL = "SELECT * FROM tblPOHeader WHERE PONUM = " & mstrCP_PO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid Return Error_EH: gstrMODULE = "Form PO - Module TVPO_Create" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GETAVINFO() Dim strVENDOR As String, strSQL As String Dim oRS As Recordset, lngNextPO As Long, lngPOLineNum As Byte Dim lngPOID As Long, strVEND_STOCK As String 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngVSTOCK As Long Dim lngSTOCK As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strSTOCK As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim lngONHAND As Long, dblONHAND As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH cb = code4init strSQL = gstrCOMPANY & "INAV" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INAVVENDOR") Call d4tagSelect(db, lngCustTag) strVEND_STOCK = mstrAVENDOR & mstrSTOCK rc = d4seek(db, strVEND_STOCK) oSTATUS = d4deleted(db) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngSTOCK = d4field(db, "INAVSTOCK") strSTOCK = f4str(lngSTOCK) If strSTOCK = mstrSTOCK Then lngVEND = d4field(db, "INAVVENDOR") lngVSTOCK = d4field(db, "INAVVSTOCK") strVEND = f4str(lngVEND) If Trim(strVEND) = Trim(mstrAVENDOR) Then mstrVSTOCK = f4str(lngVSTOCK) Else mstrVSTOCK = "" End If Else mstrVSTOCK = " " End If End If rc = d4close(db) Exit Sub Error_EH: gstrMODULE = "Form PO - Module GETAVINFO" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GETAVINFO3() Dim strVENDOR As String, strSQL As String Dim oRS As Recordset, lngNextPO As Long, lngPOLineNum As Byte Dim oRSAV As Recordset, strSQLAV As String Dim lngPOID As Long, strVEND_STOCK As String 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngVSTOCK As Long Dim lngSTOCK As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strSTOCK As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim lngONHAND As Long, dblONHAND As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO, strTEST As String On Error GoTo Error_EH ' cb = code4init strSQLAV = "SELECT * FROM tblAV WHERE STOCKNO = '" & Trim(mstrSTOCK) & "' AND VENDOR = '" & Trim(mstrAVENDOR) & "'" Set oRSAV = New Recordset oRSAV.Open strSQLAV, goConn, adOpenDynamic, adLockOptimistic If Not oRSAV.EOF Then mstrVSTOCK = Trim(Field2Str(oRSAV!VStock)) Else mstrVSTOCK = " " End If Exit Sub Error_EH: gstrMODULE = "Form PO - Module GETAVINFO3" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GETAVINFO4() Dim strVENDOR As String, strSQL As String Dim oRS As Recordset, lngNextPO As Long, lngPOLineNum As Byte Dim lngPOID As Long, strVEND_STOCK As String 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngVSTOCK As Long Dim lngSTOCK As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strSTOCK As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim lngONHAND As Long, dblONHAND As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH ' cb = code4init strSQL = gstrCOMPANY & "INAV" db6 = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db6, "INAVVENDOR") Call d4tagSelect(db6, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) strVEND_STOCK = mstrAVENDOR & mstrSTOCK rc6 = d4seek(db6, strVEND_STOCK) oSTATUS = d4deleted(db6) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngSTOCK = d4field(db6, "INAVSTOCK") strSTOCK = f4str(lngSTOCK) If strSTOCK = mstrSTOCK Then lngVEND = d4field(db6, "INAVVENDOR") lngVSTOCK = d4field(db6, "INAVVSTOCK") strVEND = f4str(lngVEND) If Trim(strVEND) = Trim(mstrAVENDOR) Then mstrVSTOCK = f4str(lngVSTOCK) Else mstrVSTOCK = "" End If Else mstrVSTOCK = " " End If End If rc6 = d4close(db6) Exit Sub Error_EH: gstrMODULE = "Form PO - Module GETAVINFO4" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub mnuSunburst_Click() Dim intRow As Integer, boolSTOP As Boolean Dim strLOCATE As String, strVDESC As String, strVSTOCK As String Dim sglActQTY As Single, dblCost As Double Dim oRS As Recordset Dim strSQL As String, strPATH As String, dblPRICE5 As Double Dim lngLINENO As Long Screen.MousePointer = vbHourglass ' cdPO.InitDir = "e:\Invoices" cdPO.DefaultExt = ".xls" cdPO.InitDir = "c:\projects\historysum" cdPO.Action = 1 strLOCATE = cdPO.FileName lngLINENO = 1 ' Call ExcelOpen ' Call ButtonReset mnuSunburst.Enabled = False ' cmdGroup.Enabled = False ' lblMessage.caption = "Importing Excel Price List -- Please Wait" ' lblMessage.Visible = True On Error GoTo Error_EH boolSTOP = False If ExcelOpen() Then ' Add New WorkBook ' strLOCATE = App.Path goExcel.Workbooks.Open (strLOCATE) ' Get currently active sheet object With goExcel.ActiveSheet ' Open Database ' Build SQL Statement strSQL = "DELETE * FROM tblSUNBURST" goConn.Execute strSQL strSQL = "SELECT * FROM tblSUNBURST" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic ' If oRS.EOF Then ' End If ' Load data into Excel intRow = 3 Do Until boolSTOP strVDESC = Trim$(.Cells(intRow, 7).Value) strVSTOCK = Trim$(.Cells(intRow, 8).Value) sglActQTY = (.Cells(intRow, 9).Value) ' sglActQTY = Trim$(.Cells(intRow, 9).value) dblCost = (.Cells(intRow, 10).Value) oRS.AddNew oRS!VStock = strVSTOCK oRS!VDesc = strVDESC oRS!Order = sglActQTY oRS!Cost = dblCost oRS!VENDOR = "SUN750" oRS!lineno = lngLINENO oRS.Update ' End If intRow = intRow + 1 If .Cells(intRow, 7).Value = "" Then boolSTOP = True End If lngLINENO = lngLINENO + 1 Loop End With oRS.Close End If goExcel.Quit ' Call ButtonReset mnuSunburst.Enabled = True ' cmdGroup.Enabled = True ' lblMessage.Visible = False mstrTABLE = "tblSunburst" Call GetStock ' Call CPPO Screen.MousePointer = vbDefault MsgBox "Sunburst Pet Import is Complete", vbInformation + vbOKOnly, "Import Complete" Exit Sub Error_EH: gstrMODULE = "Form Main - Module mnuSunburst" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub LEXPO() Dim strSQL As String, oRS As Recordset Dim strSQLL As String, oRSS As Recordset Dim dblQORDER As Double, dblQCost As Double, dblEXT As Double Dim lngPOLineNum As Long Dim strINVOICE As String, strTEST As String On Error GoTo Error_EH GoSub Set_Header strSQL = "SELECT * FROM tblPODetail" Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblLextron" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic oRS.MoveFirst Do Until oRS.EOF strINVOICE = Field2Str(oRS!Invoice) If strINVOICE <> mstrCP_PO Then mstrCP_PO = strINVOICE If lngPOLineNum <> 0 Then moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update End If GoSub Set_Header End If dblQORDER = Field2Str2(oRS!Order) dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!lineno = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(oRS!inv_no) ' mstrSTOCK = Trim(oRS!inv_no) ' Call GETAVINFO moRSPODetail!vstockno = oRS!VStock strTEST = Left(Trim(oRS!Description), 4) moRSPODetail!Desc = Trim(oRS!Description) ' moRSPODetail!balqty = oRS!Order moRSPODetail!Qty = oRS!Order moRSPODetail!Cost = oRS!Cost moRSPODetail!ActCost = oRS!Cost moRSPODetail!ActCostO = oRS!Cost moRSPODetail!LastCost = oRS!LastCost moRSPODetail!Retail1 = oRS!Retail1 moRSPODetail!ExtCost = dblEXT moRSPODetail!AExtCost = dblEXT moRSPODetail!Type = 5 moRSPODetail!NRetail = oRS!Retail1 moRSPODetail!ACTQty = oRS!Order If strTEST = "****" Then moRSPODetail!Add = vbChecked Else moRSPODetail!Add = oRS!Add End If ' moRSPODetail!Add = oRS!Add moRSPODetail.Update oRS.MoveNext Loop moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update lngPOLineNum = 0 Exit Sub Set_Header: lngPOLineNum = 1 strSQLL = "Select * FROM tblProgInfo" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = oRSS!NextPO glngPO = lngNextPO oRSS!NextPO = lngNextPO + 1 oRSS.Update strSQLL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO ' moRSPOHeader!InvoiceNo = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "LEX500" moRSPOHeader!vendorname = "Lextron Animal Health" moRSPOHeader!vaddress1 = "C/O Lextron-TEXAN LLP" moRSPOHeader!vaddress2 = "Department 1305" moRSPOHeader!vcity = "Denver" moRSPOHeader!vstate = "CO" moRSPOHeader!vzip = "80256" moRSPOHeader!VPhone = "800 292-5692" moRSPOHeader!VFAX = "800 411-4412" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "BILL" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 30 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 10 moRSPOHeader.Update strSQLL = "SELECT * FROM tblPOHeader WHERE PONUM = " & glngPO ' strSQL = "SELECT * FROM tblPOHeader WHERE PONUM = " & mstrCP_PO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid Return Error_EH: gstrMODULE = "Form PO - Module CPPO_Create" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GETALTVEND() Dim strSQL As String, oRS As Recordset strSQL = "SELECT * FROM tblAltVend WHERE Primary = '" & RTrim$(mstrAVENDOR) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then mstrOldVendor = Field2Str(oRS!secondary) End If End Sub Private Sub GETAVINFO2() Dim strVENDOR As String, strSQL As String Dim oRS As Recordset, lngNextPO As Long, lngPOLineNum As Byte Dim lngPOID As Long 'FIELD4 pointers Dim lngNAME As Long, lngVEND As Long, lngVSTOCK As Long Dim lngSTOCK As Long, lngCITY As Long, lngState As Long Dim lngZIP As Long, lngPHONE As Long, lngFAX As Long Dim lngDOC As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim strVEND As String, strNAME As String, strAdd1 As String Dim strSTOCK As String, strCITY As String, strState As String Dim strZIP As String, strPHONE As String, strFAX As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim lngONHAND As Long, dblONHAND As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH ' cb = code4init strSQL = gstrCOMPANY & "INAV" db3 = d4open(cb, fPath + strSQL) ' lngCustTag = d4tag(db3, "INAVVSTOCK") lngCustTag = d4tag(db3, "INAVVSTOCK") mstrSTOCK2 = mstrVSTOCK ' + mstrAVENDOR ' mstrSTOCK2 = mstrVSTOCK + mstrAVENDOR Call d4tagSelect(db3, lngCustTag) rc3 = d4seek(db3, mstrSTOCK2) oSTATUS = d4deleted(db3) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngSTOCK = d4field(db3, "INAVVSTOCK") strSTOCK = f4str(lngSTOCK) If strSTOCK = mstrVSTOCK Then lngVEND = d4field(db3, "INAVVENDOR") lngVSTOCK = d4field(db3, "INAVSTOCK") strVEND = f4str(lngVEND) If Trim(strVEND) = Trim(mstrAVENDOR) Or Trim(strVEND) = Trim(mstrOldVendor) Then mstrSTOCK = f4str(lngVSTOCK) mboolALIASFOUND = True Else mstrSTOCK = " " mboolALIASFOUND = False End If End If End If rc3 = d4close(db3) Exit Sub Error_EH: gstrMODULE = "Form Recieve - Module GETAVINFO2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdLabel_Click() Dim oRS As Recordset Dim strSQL As String, intCOUNT As Integer Dim intQTY As Integer, strQTY As String Dim strINVNO As String, strDESC As String, txtPRICE1 As String On Error GoTo Error_EH lstInventory.col = 0 strINVNO = lstInventory.ColText lstInventory.col = 1 strDESC = lstInventory.ColText lstInventory.col = 8 txtPRICE1 = lstInventory.ColText intCOUNT = 0 strQTY = InputBox("How Many Labels Do You Want?", "Label Quantity", 1) If strQTY = "" Then MsgBox "Cancel Pressed", vbOKOnly Exit Sub End If intQTY = Field2Str2(strQTY) If intQTY <= 0 Then intQTY = 1 End If strSQL = "SELECT * FROM tblLABELS2" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic Do Until intCOUNT = intQTY oRS.AddNew oRS!IN_STOCK = strINVNO oRS!IN_DESC1 = Field2Str(strDESC) oRS!IN_USER = gstrLOGIN oRS!IN_PRICE1 = Format(Field2Str(txtPRICE1), "$#,#.00") oRS!lbl_qty = 1 intCOUNT = intCOUNT + 1 oRS.Update Loop Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdLabel" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub PURPO() Dim strSQL As String, oRS As Recordset Dim strSQLL As String, oRSS As Recordset Dim dblQORDER As Double, dblQCost As Double, dblEXT As Double Dim lngPOLineNum As Long, dblBUYCON As Double Dim strINVOICE As String, strTEST As String On Error GoTo Error_EH GoSub Set_Header strSQL = "SELECT * FROM tblPODetail" ' WHERE poid = " & glngPOID Set moRSPODetail = New Recordset moRSPODetail.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strSQL = "SELECT * FROM tblCPImport ORDER BY CPID" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly oRS.MoveFirst mstrCP_PO = oRS!Invoice Do Until oRS.EOF strINVOICE = oRS!Invoice If strINVOICE <> mstrCP_PO Then mstrCP_PO = strINVOICE If lngPOLineNum <> 0 Then moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update End If GoSub Set_Header End If dblBUYCON = Field2Str(oRS!buycon) If dblBUYCON > 0 Then dblQORDER = Field2Str2(oRS!Order) dblQORDER = dblQORDER * dblBUYCON dblQCost = Field2Str2(oRS!Cost) dblQCost = dblQCost / dblBUYCON dblQCost = Format(dblQCost, "#,#.0000") dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) Else dblQORDER = Field2Str2(oRS!Order) dblQCost = Field2Str2(oRS!Cost) dblEXT = dblQORDER * dblQCost dblEXT = Round(dblEXT, 2) End If moRSPODetail.AddNew moRSPODetail!poid = lngPOID moRSPODetail!InvLine = lngPOLineNum moRSPODetail!lineno = lngPOLineNum lngPOLineNum = lngPOLineNum + 1 moRSPODetail!StockNo = Trim(Field2Str(oRS!inv_no)) mstrSTOCK = UCase(Trim(Field2Str(oRS!inv_no))) moRSPODetail!vstockno = Field2Str(oRS!VStock) strTEST = Left(Trim(oRS!Description), 4) moRSPODetail!Desc = Trim(Field2Str(oRS!Description)) moRSPODetail!Qty = Field2Str2(oRS!Order) mdblQORDER = dblQORDER ' mdblQORDER = Field2Str2(oRS!Order) moRSPODetail!Cost = dblQCost moRSPODetail!ActCost = dblQCost moRSPODetail!ActCostO = dblQCost moRSPODetail!LastCost = Field2Str2(oRS!LastCost) moRSPODetail!Retail1 = Field2Str2(oRS!Retail1) moRSPODetail!ExtCost = dblEXT moRSPODetail!AExtCost = dblEXT moRSPODetail!NRetail = Field2Str2(oRS!Retail1) moRSPODetail!BalQty = oRS!Order - moRSPODetail!ACTQty moRSPODetail!Type = 5 moRSPODetail!NRetail = Field2Str2(oRS!Retail1) moRSPODetail!ACTQty = dblQORDER If strTEST = "****" Then moRSPODetail!Add = vbChecked Else moRSPODetail!Add = oRS!Add End If ' moRSPODetail!Add = oRS!Add moRSPODetail!Weight = Field2Str2(oRS!Weight) moRSPODetail!PVendor = Field2Str(oRS!PVendor) moRSPODetail.Update oRS.MoveNext Call UpONOrder Loop moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!DetailLines = lngPOLineNum - 1 moRSPOHeader.Update lngPOLineNum = 0 Exit Sub Set_Header: lngPOLineNum = 1 strSQLL = "Select * FROM tblProgInfo" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenForwardOnly, adLockOptimistic lngNextPO = oRSS!NextPO glngPO = lngNextPO oRSS!NextPO = lngNextPO + 1 oRSS.Update strSQLL = "SELECT * FROM tblPOHeader" Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If mstrVENDOR = "PUR500" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoiceno = mstrCP_PO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!vendorid = "PUR500" moRSPOHeader!vendorname = "Purina Mills Inc." moRSPOHeader!vaddress1 = "P.O. Box 248" moRSPOHeader!vaddress2 = "Attn: Financial Services" moRSPOHeader!vcity = "Commerce City" moRSPOHeader!vstate = "CO" moRSPOHeader!vzip = "80037-00248" moRSPOHeader!VPhone = "800 747-2469" moRSPOHeader!VFAX = "888 590-2463" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "MARK" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 0 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 0 moRSPOHeader.Update ElseIf mstrVENDOR = "PURIMIL" Then moRSPOHeader.AddNew moRSPOHeader!ponum = glngPO moRSPOHeader!invoicedate = mstrDATE moRSPOHeader!invoiceno = "" moRSPOHeader!vendorid = "PURIMIL" moRSPOHeader!vendorname = "Purina Mills Inc." moRSPOHeader!vaddress1 = "P.O. Box 248" moRSPOHeader!vaddress2 = "Attn: Financial Services" moRSPOHeader!vcity = "Commerce City" moRSPOHeader!vstate = "CO" moRSPOHeader!vzip = "80037-00248" moRSPOHeader!VPhone = "800 747-2469" moRSPOHeader!VFAX = "888 590-2463" moRSPOHeader!OrderDate = mstrDATE moRSPOHeader!DueDate = mstrDATE moRSPOHeader!Buyer = "MANAGER" moRSPOHeader!duectl = 0 moRSPOHeader!dueday = 0 moRSPOHeader!disctl = 0 moRSPOHeader!disday = 0 moRSPOHeader.Update End If strSQLL = "SELECT * FROM tblPOHeader WHERE PONUM = " & glngPO Set moRSPOHeader = New Recordset moRSPOHeader.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lngPOID = moRSPOHeader!poid Return Error_EH: gstrMODULE = "Form PO - Module PURPO" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub UpONOrder() Dim lngCustTag As Long, strSQL As String Dim dblONORDER As Double, dblCALCONORDER As Double Dim lngONORDER As Long, lngDESC As Long, strDESC As String strDESC = Trim(mstrSTOCK) If Trim(mstrSTOCK) <> "" Then strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngONORDER = d4field(db, "IN_ORDERTE") lngDESC = d4field(db, "IN_DES") strDESC = f4str(lngDESC) dblONORDER = f4str(lngONORDER) dblCALCONORDER = dblONORDER + mdblQORDER If dblCALCONORDER < 0 Then dblCALCONORDER = 0 End If Call f4assignDouble(lngONORDER, dblCALCONORDER) End If rc = d4close(db) strSQL = gstrCOMPANY & "INMAT" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INMXSTOCK3") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngONORDER = d4field(db, "INMXONORDR") lngODATE = d4field(db, "INMXLSORDR") dblONORDER = f4str(lngONORDER) dblCALCONORDER = dblONORDER + mdblQORDER If dblCALCONORDER < 0 Then dblCALCONORDER = 0 End If ' dblONORDER = f4str(lngONORDER) ' strONORDER = Field2Str2(strONORDER) ' dblONORDER = CDbl(strONORDER) ' dblQORDER = Field2Str2(oRS!Order) ' dblCALCONORDER = dblONORDER + dblQORDER Call f4assignDouble(lngONORDER, dblCALCONORDER) ' Call f4assignDateTime(lngODATE, strDATE) ' Call f4assign(lngODATE, strDATE) End If rc = d4close(db) End If End Sub Private Sub UpONOrderHold() Dim lngCustTag As Long, strSQL As String Dim dblONORDER As Double, dblCALCONORDER As Double Dim lngONORDER As Long, lngDESC As Long, strDESC As String ' mstrSTOCK = Trim(oRS!Inv_No) strDESC = Trim(mstrSTOCK) If Trim(mstrSTOCK) <> "" Then ' If strDESC = "" Then strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) ' mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngONORDER = d4field(db, "IN_ORDERTE") lngDESC = d4field(db, "IN_DES") strDESC = f4str(lngDESC) dblONORDER = f4str(lngONORDER) ' mdblQORDER = Field2Str2(oRS!Order) ' dblCALCONORDER = dblONORDER - mdblQORDER dblCALCONORDER = dblONORDER + mdblQORDER If dblCALCONORDER < 0 Then dblCALCONORDER = 0 End If Call f4assignDouble(lngONORDER, dblCALCONORDER) End If rc = d4close(db) End If End Sub Private Sub CalcSales() Dim strSQL As String, oSTATUS As Long, strINDEX As String Dim strLine As String, strLINE2 As String Dim lngRET As Long, aTabs(7) As Long, strAmount As String * 12 Dim dblSOLD As Double, dblBUY As Double, dblNET As Double Dim strSQLL As String, oRS As Recordset 'FIELD4 pointers Dim lngNAME As Long, lngCUST As Long, lngINVTOT As Long Dim lngINVNO As Long, lngINVDATE As Long, lngType As Long Dim lngRECORD As Long, lngQTY As Long, lngPRICE As Long Dim lngDOC As Long, lngSTOCK As Long 'TAG4 pointers Dim lngCustTag As Long 'INDEX4 pointers Dim ind1 As Long 'Field value holders Dim dblINVTOT As Double, dblTYPE As Double, dblAMOUNT As Double Dim strNAME As String, strCUST As String, lngPSHIREC As Long Dim strINVNO As String, strINVDATE As String, strNEWDATE As String Dim dblQTY As Double, dblPRICE As Double, strDOC As String, strSTOCK As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double 'Others Dim fldArray As Long, tagArray As Long Dim FileName As String, db2 As Long Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer Dim rc1 As Integer, rc2 As Integer Dim indexInfo() As TAG4INFO On Error GoTo Error_EH If Not IsDate(txtBegDate) Then strMSG = "You Must Have Beginning and Ending Date Entered - ReEnter" MsgBox strMSG, vbCritical + vbOKOnly, "InValid Dates" Exit Sub End If strSQLL = "SELECT * FROM tblPOLIST WHERE User = '" & gstrLOGIN & "' " & " ORDER BY ListID" ' strSQL = "SELECT * FROM tblPOLIST SORTedBY ListID WHERE User = '" & gstrLOGIN & "'" Set oRS = New Recordset oRS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic gboolVEND = False mstrBEGDATE = Year(txtBegDate) & Format(Month(txtBegDate), "00") & Format(Day(txtBegDate), "00") mstrENDDATE = Year(txtEndDate) & Format(Month(txtEndDate), "00") & Format(Day(txtEndDate), "00") Do Until oRS.EOF mstrCUSTOMER = Field2Str(oRS!inv_no) cb = code4init strSQL = gstrCOMPANY & "INHIS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INHISTOCK") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrCUSTOMER) Do Until rc <> r4success oSTATUS = d4deleted(db) mstrCUSTOMER2 = "" If oSTATUS = 0 Then lngNAME = d4field(db, "INHICV") lngDOC = d4field(db, "INHIDOC") lngINVDATE = d4field(db, "INHIDATE") lngINVNO = d4field(db, "INHISOURCE") lngRECORD = d4field(db, "INHIUNIQ") lngType = d4field(db, "INHITYPE") lngPRICE = d4field(db, "INHIPRICE") lngQTY = d4field(db, "INHIQTY") lngCOST = d4field(db, "INHICOST") strDOC = f4str(lngDOC) strNAME = f4str(lngNAME) If strNAME <> "" Then If strNAME <> mstrCUSTNO Then mstrCUSTNO = "" mstrCUSTNAME = "" mstrCUSTOMER2 = strNAME ' Call CustomerFind End If Else mstrCUSTNO = "" mstrCUSTNAME = "" End If strINVDATE = f4str(lngINVDATE) strMONTH = date4month(strINVDATE) Call date4format(strINVDATE, strNEWDATE, "CCYY/MM/DD") dblPRICE = f4double(lngPRICE) RSet strAmount = FormatCurrency(dblPRICE, 2) strINVNO = f4str(lngINVNO) lngPSHIREC = f4long(lngRECORD) dblTYPE = f4double(lngType) dblQTY = f4double(lngQTY) dblCost = f4double(lngCOST) dblTCOST = dblCost If dblQTY > 0 Then dblCost = dblCost / dblQTY End If RSet strCOST = FormatCurrency(dblCost, 2) If dblTYPE = 1 Then strTYPE = "SUB" If strINVDATE >= mstrBEGDATE And strINVDATE <= mstrENDDATE Then If strINVNO = "PS" Or strINVNO = "OE" Or strINVNO = "AG" Then dblSOLD = dblSOLD + dblQTY End If End If ' Else ' strTYPE = "TRANS" End If End If rc = d4seekNext(db, mstrCUSTOMER) Loop rc = d4close(db) oRS!Order = dblSOLD oRS!usage = dblSOLD If dblSOLD = 0 And chkZero Then oRS.Delete Else oRS.Update End If oRS.MoveNext dblQTY = 0 dblSOLD = 0 dblCost = 0 dblTCOST = 0 Loop Exit Sub Error_EH: gstrMODULE = "Form PO - Module CalcSales" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdImportInv_Click() Dim ARCode As Long, oSTATUS As Long Dim lngSTOCKNO As Long, lngQTY As Long, lngDESC As Long Dim strSTOCKNO As String, dblQTY As Double, strDESC As String Dim strREGISTER As String, strFIND As String, strVENDOR As String, strVENDOR2 As String * 20 Dim strSQL As String, strFILE As String, strMSG As String Dim lngLCOST As Long, lngPRICE1 As Long, dblLCOST As Double, dblPRICE1 As Double Dim lngVEND As Long Dim lngWEIGHT As Long, dblWEIGHT As Double 'Field value holders Dim dblINVTOT As Double, dblTYPE As Double, dblAMOUNT As Double Dim strNAME As String, strCUST As String, lngPSHIREC As Long Dim strINVNO As String, strINVDATE As String, strNEWDATE As String Dim dblPRICE As Double, strDOC As String, strSTOCK As String Dim strTYPE As String, lngCOST As Long, dblCost As Double, strCOST As String * 12 Dim strMONTH As String, dblTCOST As Double Dim strINDEX As String Dim strLine As String, strLINE2 As String Dim lngRET As Long, aTabs(7) As Long, strAmount As String * 12 Dim dblSOLD As Double, dblBUY As Double, dblNET As Double Dim strSQLL As String, oRS As Recordset Dim strLOrder As String, strLPur As String, strLSALE As String 'FIELD4 pointers Dim lngNAME As Long, lngCUST As Long, lngINVTOT As Long Dim lngINVNO As Long, lngINVDATE As Long, lngType As Long Dim lngRECORD As Long, lngPRICE As Long Dim lngDOC As Long, lngSTOCK As Long Dim lngLOrder As Long, lngLPur As Long, lngLSALE As Long strSQL = "DELETE * FROM tblINMAS" goConn.Execute strSQL strSQL = "SELECT * FROM tblINMAS" Set moRSHAND = New Recordset moRSHAND.Open strSQL, goConn, adOpenDynamic, adLockOptimistic strVENDOR2 = Trim(txtBegSelect) strFILE = gstrCOMPANY & "INMAS.DBF" '"IN_VENDOR" db = d4open(cb, fPath + strFILE) lngCustTag = d4tag(db, "IN_VENDOR") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, strVENDOR2) ' rc = d4seek(db, strINVSTOCK) If rc = r4success Then Do oSTATUS = d4deleted(db) If oSTATUS = 0 Then dblMIN = 0 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 lngSTOCKNO = d4field(db, "IN_STOCK") lngQTY = d4field(db, "IN_ONHAND") lngDESC = d4field(db, "IN_DES") lngLCOST = d4field(db, "IN_LSCOST") lngPRICE1 = d4field(db, "IN_PRICE1") lngVEND = d4field(db, "IN_VENDOR") lngType = d4field(db, "IN_TYPE") lngONHAND = d4field(db, "IN_ONHAND") lngMIN = d4field(db, "IN_MINQTY") lngMAX = d4field(db, "IN_MAXQTY") lngCOMMIT = d4field(db, "IN_COMMIT") lngONORDER = d4field(db, "IN_ORDERTE") lngWEIGHT = d4field(db, "IN_FIELD07") lngLOrder = d4field(db, "IN_LSORDR") lngLPur = d4field(db, "IN_LSPRCH") lngLSALE = d4field(db, "IN_LSSALE") dblWEIGHT = f4double(lngWEIGHT) strSTOCKNO = f4str(lngSTOCKNO) strSTOCKNO = Trim$(strSTOCKNO) strTYPE = Trim(f4str(lngType)) dblMIN = f4double(lngMIN) dblMAX = f4double(lngMAX) dblONHAND = f4double(lngONHAND) dblONORDER = f4double(lngONORDER) dblCOMMIT = f4double(lngCOMMIT) dblAVAIL = dblONHAND - dblCOMMIT dblQTY = f4double(lngQTY) dblLCOST = f4double(lngLCOST) dblPRICE1 = f4double(lngPRICE1) strDESC = f4str(lngDESC) strVENDOR = f4str(lngVEND) strLOrder = f4str(lngLOrder) strLPur = f4str(lngLPur) strLSALE = f4str(lngLSALE) If Trim$(strVENDOR) = Trim$(txtBegSelect) Then ' strFIND = "STOCKNO = '" & strSTOCKNO & "'" moRSHAND.AddNew moRSHAND!StockNo = Field2Str(strSTOCKNO) ' If Not moRSHAND.EOF Then ' moRSHAND!Count = Field2Str2(moRSHAND!Count) + Field2Str2(dblQTY) moRSHAND!Description = Field2Str(strDESC) moRSHAND!OnHand = dblQTY moRSHAND!LCost = dblLCOST moRSHAND!Price1 = dblPRICE1 moRSHAND!VENDOR = strVENDOR moRSHAND!Type = strTYPE moRSHAND!Min = dblMIN moRSHAND!Max = dblMAX moRSHAND!Available = dblAVAIL moRSHAND!Weight = dblWEIGHT moRSHAND!User = gstrLOGIN moRSHAND!LastOrder = strLOrder moRSHAND!LastPurchase = strLPur moRSHAND!LastSale = strLSALE moRSHAND.Update End If ' End If End If rc = d4seekNext(db, strVENDOR2) ' rc = d4skip(db, 1) Loop While rc = r4success End If '******* Need to look at the logic to see why this is not caclulating correctly rc = d4close(db) moRSHAND.Close End Sub Private Sub SelectPartialLoad2() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim lngLSTCOST As Long, lngRETAIL1 As Long Dim dblLSTCOST As String, dblRETAIL1 As String Dim strVEND As String, strTYPE As String, strINVNO As String, strDESC As String * 45 Dim strSELECT As String, strBEG As String * 45, strEND As String * 45 Dim oRS As Recordset Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim dblOrder As Double, dblCost As Double, dblALLTOTAL As Double Dim lngBUYCON As Long, dblBUYCON As Double, intREM As Integer, intWHOLE As Integer Dim lngONORDER As Long, dblONORDER As Double Dim strBEG2 As String, strEND2 As String Dim oRSS As Recordset Dim strLOrder As String, strLPur As String, strLSALE As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH On Error Resume Next mlngCOUNT = 0 strBEG = txtBegSelect strEND = txtEndSelect strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic strSQLL = "SELECT * FROM tblINMAS WHERE User = '" & gstrLOGIN & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lstInventory.SortState = SortStateSuspend Do Until oRSS.EOF mlngCOUNT = mlngCOUNT + 1 dblMIN = 0 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 dblLSTCOST = 0 dblRETAIL1 = 0 dblCost = 0 strINVNO = Field2Str(oRSS!StockNo) strDESC = Field2Str(oRSS!Description) strVEND = Field2Str(oRSS!VENDOR) strTYPE = Field2Str(oRSS!Type) dblMIN = Field2Str(oRSS!Min) dblMAX = Field2Str(oRSS!Max) dblONHAND = Field2Str(oRSS!OnHand) dblAVAIL = Field2Str(oRSS!Available) dblLSTCOST = Field2Str(oRSS!LCost) dblRETAIL1 = Field2Str(oRSS!Price1) dblWEIGHT = Field2Str2(oRSS!Weight) dblCost = Field2Str(oRSS!LCost) strLOrder = Field2Str(oRSS!LastOrder) strLPur = Field2Str(oRSS!LastPurchase) strLSALE = Field2Str(oRSS!LastSale) With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str2(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX ' !Available = dblALLTOTAL !OnOrder = dblONORDER !Available = dblAVAIL '' !Order = dblOrder !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With oRSS.MoveNext Loop oRS.Close oRSS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load mlngCOUNT = mlngCOUNT On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module SelectPartialLoad2" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SelectPartialLoad3() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String Dim lngVEND As Long, lngType As Long, lngONHAND As Long Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long Dim lngNAME As Long, lngCUST As Long Dim lngLSTCOST As Long, lngRETAIL1 As Long Dim dblLSTCOST As String, dblRETAIL1 As String Dim strVEND As String, strTYPE As String, strINVNO As String, strDESC As String * 45 Dim strSELECT As String, strBEG As String * 45, strEND As String * 45 Dim oRS As Recordset Dim lngMIN As Long, lngMAX As Long, lngCOMMIT As Long Dim dblMIN As Double, dblMAX As Double, dblCOMMIT As Double, dblAVAIL As Double Dim dblOrder As Double, dblCost As Double, dblALLTOTAL As Double Dim lngBUYCON As Long, dblBUYCON As Double, intREM As Integer, intWHOLE As Integer Dim lngONORDER As Long, dblONORDER As Double Dim strBEG2 As String, strEND2 As String Dim oRSS As Recordset Dim strLOrder As String, strLPur As String, strLSALE As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH On Error Resume Next mlngCOUNT = 0 strBEG = txtBegSelect strEND = txtEndSelect strSELECT = "SELECT * FROM tblPOList" Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenDynamic, adLockOptimistic strSQLL = "SELECT * FROM tblINMAS WHERE User = '" & gstrLOGIN & "'" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic lstInventory.SortState = SortStateSuspend Do Until oRSS.EOF mlngCOUNT = mlngCOUNT + 1 dblMIN = 0 dblMAX = 0 dblCOMMIT = 0 dblAVAIL = 0 dblLSTCOST = 0 dblRETAIL1 = 0 dblCost = 0 strINVNO = Field2Str(oRSS!StockNo) strDESC = Field2Str(oRSS!Description) strVEND = Field2Str(oRSS!VENDOR) strTYPE = Field2Str(oRSS!Type) dblMIN = Field2Str(oRSS!Min) dblMAX = Field2Str(oRSS!Max) dblONHAND = Field2Str(oRSS!OnHand) dblAVAIL = Field2Str(oRSS!Available) dblLSTCOST = Field2Str(oRSS!LCost) dblRETAIL1 = Field2Str(oRSS!Price1) dblWEIGHT = Field2Str2(oRSS!Weight) dblCost = Field2Str(oRSS!LCost) strLOrder = Field2Str(oRSS!LastOrder) strLPur = Field2Str(oRSS!LastPurchase) strLSALE = Field2Str(oRSS!LastSale) With oRS .AddNew !inv_no = Field2Str(strINVNO) !Description = Field2Str2(strDESC) !VENDOR = Field2Str(strVEND) !Type = Field2Str(strTYPE) !OnHand = dblONHAND !Min = dblMIN !Max = dblMAX ' !Available = dblALLTOTAL !OnOrder = dblONORDER !Available = dblAVAIL !Order = 1 !LastCost = dblLSTCOST !Retail1 = dblRETAIL1 !Cost = dblLSTCOST !Weight = dblWEIGHT !LastOrder = strLOrder !LastPurchase = strLPur !LastSale = strLSALE !User = gstrLOGIN .Update End With oRSS.MoveNext Loop oRS.Close oRSS.Close lstInventory.SortState = SortStateActiveReSort Call Inventory2Load mlngCOUNT = mlngCOUNT On Error GoTo 0 Exit Sub Error_EH: gstrMODULE = "Form PO - Module SelectPartialLoad3" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown Dim intBookmark As Integer, intTEST As Integer If cboSort.ListIndex = 4 Then If KeyCode = vbKeyReturn Then Call LoadInventory End If End If End Sub Private Sub cmdZeroOnOrd_Click() Dim oSTATUS As Long Dim strSQL As String, strSQLL As String, dblONHAND As Double Dim strLine As String, strCode As String, strCompany As String Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngCOMMIT As Long, dblCOMMIT As Double 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH strSQL = gstrCOMPANY & "INMAS" db7 = d4open(cb, fPath + strSQL) rc7 = d4top(db7) If d4top(db7) = r4success Then Do oSTATUS = d4deleted(db7) If oSTATUS = 0 Then With lstInventory lngNAME = d4field(db7, "IN_STOCK") lngCUST = d4field(db7, "IN_DES") lngONHAND = d4field(db7, "IN_ORDERTE") strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) dblONHAND = f4double(lngONHAND) If dblONHAND > 0 Then Call f4assignDouble(lngONHAND, 0) End If End With End If rc7 = d4skip(db7, 1) Loop While rc7 = r4success rc7 = d4flush(db7) rc7 = d4unlock(db7) End If rc7 = d4close(db7) strSQL = gstrCOMPANY & "INMAT" db7 = d4open(cb, fPath + strSQL) rc = d4top(db7) If d4top(db7) = r4success Then Do oSTATUS = d4deleted(db7) If oSTATUS = 0 Then With lstInventory lngNAME = d4field(db7, "INMXSTOCK") lngONHAND = d4field(db7, "INMXONORDR") strNAME = f4str(lngNAME) dblONHAND = f4double(lngONHAND) If dblONHAND > 0 Then Call f4assignDouble(lngONHAND, 0) End If End With End If rc7 = d4skip(db7, 1) Loop While rc7 = r4success rc7 = d4flush(db7) rc7 = d4unlock(db7) End If rc7 = d4close(db7) Exit Sub Error_EH: gstrMODULE = "Form PO - Module cmdZeroOnHand" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FixONOrder() Dim oSTATUS As Long, intBOOKMARK99 As Integer Dim strSQL As String, strSQLL As String, dblONHAND As Double, oRS As Recordset Dim strLine As String, strCode As String, strCompany As String Dim strNAME2 As String, lngNAME2 As Long, lngONHANDX As Long, dblONHANDX As Double Dim strNAME As String, strCUST As String, strVEND As String, strTYPE As String Dim lngRET As Long, aTabs(2) As Long, lngRECORD As Long, lngONHAND As Long Dim lngNAME As Long, lngCUST As Long, lngVEND As Long, lngType As Long Dim lngCOMMIT As Long, dblCOMMIT As Double Dim strSTOCK As String, dblQTY As Double, intCoun As Integer Dim intCNT As Integer, intCNT2 As Integer Dim lngCustTag2 As Long, intTEST As Integer Dim lngMXSTOCK As Long, strMXSTOCK As String, lngMXONHAND As Long, dblMXONHAND As Double Dim strMXLOC As String * 20, strMXSTK As String * 20, strMXSEARCH As String 'TAG4 pointers Dim lngCustTag As Long On Error GoTo Error_EH ' intBOOKMARK99 = lstInventory.ListIndex lstInventory.col = 0 mstrSTOCK = lstInventory.ColText intCNT = 0 intCNT2 = 0 'lstinventory.col=10 'lstinventory.ColText= strSQLL = "SELECT * FROM tblPODetail WHERE not Complete and not DelFlag and StockNo = '" & mstrSTOCK & "'" ' strSQLL = "SELECT * FROM tblPODetail WHERE not Complete and not DelFlag " Set oRS = New Recordset oRS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic intCoun = oRS.RecordCount '********************************** strSQL = gstrCOMPANY & "INMAS" strSQLL = gstrCOMPANY & "INMAT" db = d4open(cb, fPath + strSQL) db6 = d4open(cb, fPath + strSQLL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) lngCustTag2 = d4tag(db6, "INMXSTOCK3") ' lngCustTag2 = d4tag(db6, "INMXSTOCK") Call d4tagSelect(db6, lngCustTag2) Do Until oRS.EOF strSTOCK = Field2Str(oRS!StockNo) strMXSTK = Field2Str(oRS!StockNo) strMXSEARCH = strMXSTK & strMXLOC dblQTY = oRS!Qty If IsNull(strSTOCK) Or strSTOCK = "" Then Else rc = d4seek(db, strSTOCK) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngNAME = d4field(db, "IN_STOCK") lngCUST = d4field(db, "IN_DES") lngONHAND = d4field(db, "IN_ORDERTE") strNAME = f4str(lngNAME) strCUST = f4str(lngCUST) dblONHAND = f4double(lngONHAND) If Trim(strSTOCK) = Trim(strNAME) Then dblONHAND = dblONHAND + dblQTY Call f4assignDouble(lngONHAND, dblONHAND) End If intCNT2 = intCNT2 + 1 End If intCNT = intCNT + 1 rc6 = d4seek(db6, strSTOCK) oSTATUS = d4deleted(db6) If oSTATUS = 0 Then lngNAME2 = d4field(db6, "INMXSTOCK") lngONHANDX = d4field(db6, "INMXONORDR") strNAME2 = f4str(lngNAME2) dblONHANDX = f4double(lngONHANDX) If Trim(strMXSTK) = Trim(strNAME) Then dblONHANDX = dblONHANDX + dblQTY Call f4assignDouble(lngONHANDX, dblONHANDX) End If End If End If oRS.MoveNext Loop rc = d4close(db) rc6 = d4close(db6) lstInventory.col = 10 lstInventory.ColText = dblONHANDX ' lstInventory.Refresh inttext = lstInventory.ListIndex ' lstInventory.ListIndex = mintbookmark99 Exit Sub Error_EH: gstrMODULE = "Form PO - Module FixOnOrder" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ChgONOrder() Dim lngCustTag As Long, strSQL As String Dim dblONORDER As Double, dblCALCONORDER As Double Dim lngONORDER As Long, lngDESC As Long, strDESC As String lstInventory.col = 0 mstrSTOCK = lstInventory.ColText strDESC = Trim(mstrSTOCK) If Trim(mstrSTOCK) <> "" Then strSQL = gstrCOMPANY & "INMAS" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "IN_STOCK2") Call d4tagSelect(db, lngCustTag) mstrSTOCK = UCase(mstrSTOCK) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngONORDER = d4field(db, "IN_ORDERTE") lngDESC = d4field(db, "IN_DES") strDESC = f4str(lngDESC) ' dblONORDER = f4str(lngONORDER) ' dblCALCONORDER = dblONORDER + mdblQORDER ' If dblCALCONORDER < 0 Then dblCALCONORDER = 0 ' End If Call f4assignDouble(lngONORDER, dblCALCONORDER) End If rc = d4close(db) strSQL = gstrCOMPANY & "INMAT" db = d4open(cb, fPath + strSQL) lngCustTag = d4tag(db, "INMXSTOCK3") Call d4tagSelect(db, lngCustTag) rc = d4seek(db, mstrSTOCK) oSTATUS = d4deleted(db) If oSTATUS = 0 Then lngONORDER = d4field(db, "INMXONORDR") dblCALCONORDER = 0 Call f4assignDouble(lngONORDER, dblCALCONORDER) End If rc = d4close(db) End If End Sub Private Sub GetAFN() Dim strSQL As String, oRS As Recordset mstrN_LC = "" mstrN_RTL = "" mstrN_VS = "" mstrN_VND = "" mstrN_LPD = "" mstrN_Desc = "" mstrN_TY = "" strSQL = "SELECT AFN_LCost, AFN_Retail, AFN_VSTOCK, AFN_VEND, AFN_DESC, AFN_PDATE, AFN_TYPE FROM tblPriceCompare WHERE AFN_SKU = '" & mstrFStock & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then mstrN_LC = Format(Field2Str(oRS!AFN_LCost), "##,##0.00") mstrN_RTL = Format(Field2Str(oRS!AFN_Retail), "##,##0.00") mstrN_VS = Field2Str(oRS!AFN_VStock) mstrN_VND = Field2Str(oRS!AFN_VEND) mstrN_Desc = Field2Str(oRS!AFN_Desc) mstrN_LPD = Field2Str(oRS!AFN_PDATE) mstrN_TY = Field2Str(oRS!AFN_TYPE) Else mstrN_LC = "NO INFORMATION FOUND" End If End Sub Private Sub GetAFS() Dim strSQL As String, oRS As Recordset On Error GoTo Error_EH mstrS_LC = "" mstrS_RTL = "" mstrS_VS = "" mstrS_VND = "" mstrS_LPD = "" mstrS_Desc = "" mstrS_TY = "" ' strSQL = "SELECT * FROM tblPriceCompare WHERE AFSSKU = '" & mstrFStock & "'" ' If Not gboolConn3Bad Then strSQL = "SELECT AFS_LCost, AFS_Retail, AFS_VSTOCK, AFS_VEND, AFS_DESC, AFS_PDATE, AFS_TYPE FROM tblPriceCompare WHERE AFS_SKU = '" & mstrFStock & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' oRS.Open strSQL, goConn3, adOpenForwardOnly, adLockReadOnly ' Else ' MsgBox "Cannot Process AFS History", vbOKOnly, "No History" ' Exit Sub ' End If If Not oRS.EOF Then mstrS_LC = Format(Field2Str(oRS!AFS_LCost), "##,##0.00") mstrS_RTL = Format(Field2Str(oRS!AFS_Retail), "##,##0.00") mstrS_VS = Field2Str(oRS!AFS_VStock) mstrS_VND = Field2Str(oRS!AFS_VEND) mstrS_Desc = Field2Str(oRS!AFS_Desc) mstrS_LPD = Field2Str(oRS!AFS_PDATE) mstrS_TY = Field2Str(oRS!AFS_TYPE) Else mstrS_LC = "NO INFORMATION FOUND" End If Exit Sub Error_EH: gstrMODULE = gstrMODULE & "Form PO - Module GetAFS" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetTSS() Dim strSQL As String, oRS As Recordset mstrT_LC = "" mstrT_RTL = "" mstrT_VS = "" mstrT_VND = "" mstrT_LPD = "" mstrT_Desc = "" mstrT_TY = "" strSQL = "SELECT TSS_LCost, TSS_Retail, TSS_VSTOCK, TSS_VEND, TSS_DESC, TSS_PDATE, TSS_TYPE FROM tblPriceCompare WHERE TSS_SKU = '" & mstrFStock & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then mstrT_LC = Format(Field2Str(oRS!TSS_LCost), "##,##0.00") mstrT_RTL = Format(Field2Str(oRS!TSS_Retail), "##,##0.00") mstrT_VS = Field2Str(oRS!TSS_VStock) mstrT_VND = Field2Str(oRS!TSS_VEND) mstrT_Desc = Field2Str(oRS!TSS_Desc) mstrT_LPD = Field2Str(oRS!TSS_PDATE) mstrT_TY = Field2Str(oRS!TSS_TYPE) Else mstrT_LC = "NO INFORMATION FOUND" End If End Sub Private Sub GetTSSHist() Dim strSQL As String, oRS As Recordset mstrT_LM = "" mstrT_LY = "" mstrT_YA = "" mstrT_ICLM = "" mstrT_ICLY = "" mstrT_ICYA = "" strSQL = "SELECT * FROM tblUSAGET WHERE StockNo = '" & Trim(moRSUpdate!inv_no) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then mstrT_LM = Field2Str2(oRS!LastMo) mstrT_LY = Field2Str2(oRS!LastYr) mstrT_YA = Field2Str2(oRS!YearAgo) mstrT_ICLM = Field2Str2(oRS!ICLastMo) mstrT_ICLY = Field2Str2(oRS!ICLastYr) mstrT_ICYA = Field2Str2(oRS!ICYearAgo) Else mstrT_LM = " NO SALES INFORMATION FOUND " End If End Sub Private Sub GetAFNHist() Dim strSQL As String, oRS As Recordset mstrN_LM = "" mstrN_LY = "" mstrN_YA = "" mstrN_ICLM = "" mstrN_ICLY = "" mstrN_ICYA = "" strSQL = "SELECT * FROM tblUSAGEN WHERE StockNo = '" & Trim(moRSUpdate!inv_no) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then mstrN_LM = Field2Str2(oRS!LastMo) mstrN_LY = Field2Str2(oRS!LastYr) mstrN_YA = Field2Str2(oRS!YearAgo) mstrN_ICLM = Field2Str2(oRS!ICLastMo) mstrN_ICLY = Field2Str2(oRS!ICLastYr) mstrN_ICYA = Field2Str2(oRS!ICYearAgo) Else mstrN_LM = " NO SALES INFORMATION FOUND " End If End Sub Private Sub GetAFSHist() Dim strSQL As String, oRS As Recordset mstrS_LM = "" mstrS_LY = "" mstrS_YA = "" mstrS_ICLM = "" mstrS_ICLY = "" mstrS_ICYA = "" strSQL = "SELECT * FROM tblUSAGES WHERE StockNo = '" & Trim(moRSUpdate!inv_no) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then mstrS_LM = Field2Str2(oRS!LastMo) mstrS_LY = Field2Str2(oRS!LastYr) mstrS_YA = Field2Str2(oRS!YearAgo) mstrS_ICLM = Field2Str2(oRS!ICLastMo) mstrS_ICLY = Field2Str2(oRS!ICLastYr) mstrS_ICYA = Field2Str2(oRS!ICYearAgo) Else mstrS_LM = " NO SALES INFORMATION FOUND " End If End Sub