azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmPO.frm
Mike Swanson 5359e7c49e feat(valleywide): recover VWP Orders VB6 source from D: backup drive 
Recovered Darv's VB6 source for the Valley Wide Plastering Orders
application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used).
This is the first time we've had the actual source — prior session only
had a single frmPayroll.frm from the AD server.

Three project variants identified across two snapshots:
- Full-Project/   (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\
- Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\
- Source/         (170 files, 559 MB)   — D:\Office-Estimates\Darv\Source\ wholesale
- SOURCE-HOLD/    (3 files, 1 MB)       — D:\Office-Estimates\Darv\SOURCE HOLD\

Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production
Orders_10A.exe was live as of April 2024 — open question whether newer
source exists on other backup drives Mike will scan next.

Also includes per-category and per-keyword analysis CSVs from a WizTree
file-list export, plus the analyzer script that produced them
(re-runnable for the next drive's CSV).

VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live
VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:36:27 -07:00

9648 lines
326 KiB
Plaintext
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink