Woozle at 12:48, 14 October 2022

2022-10-14T12:48:20Z

← Older revision		Revision as of 12:48, 14 October 2022
Line 1:		Line 1:
	<VB>		<syntaxhighlight lang=VB>
	' CLASS: clsPackageItem		' CLASS: clsPackageItem

Line 441:		Line 441:
	End With		End With
	End Sub		End Sub
	</VB>		</syntaxhighlight>

Woozle: Woozle moved page VbzCart/code/VBA/clsPackageItem to VbzCart/archive/code/VBA/clsPackageItem

2014-12-19T02:08:58Z

Woozle moved page VbzCart/code/VBA/clsPackageItem to VbzCart/archive/code/VBA/clsPackageItem

← Older revision	Revision as of 02:08, 19 December 2014
(No difference)

Woozle: Created page with " ' CLASS: clsPackageItem Option Compare Database Option Explicit Private vID As Long Private vPkg As Long Private vItem As Long Private vOrdItem As Long Private vQtyShipp..."

2014-05-08T00:48:07Z

Created page with "<VB> ' CLASS: clsPackageItem Option Compare Database Option Explicit Private vID As Long Private vPkg As Long Private vItem As Long Private vOrdItem As Long Private vQtyShipp..."

New page

<VB>
' CLASS: clsPackageItem

Option Compare Database
Option Explicit
Private vID As Long
Private vPkg As Long
Private vItem As Long
Private vOrdItem As Long
Private vQtyShipped As Long ' qty shipped as ordered
Private vQtyExtra As Long ' qty shipped unrequested
Private vQtyNotAvail As Variant
Private vQtyCancelled As Variant
Public Sub Init(iFields As Fields)
With iFields
vID = !ID
vPkg = !ID_Package
vItem = Nz(!ID_Item)
vOrdItem = Nz(!ID_OrderItem)
vQtyShipped = Nz(!QtyShipped)
vQtyExtra = Nz(!QtyExtra)
vQtyNotAvail = !QtyNotAvail
vQtyCancelled = !QtyCancelled
End With
End Sub
Public Sub InitNew(iParent As clsPackage)
' ACTION: creates a new line item for the given package
' ASSUMES: no fields have been filled in beforehand; must be saved explicitly afterwards if those fields are to be written to the db
vPkg = iParent.ID
With clsPackageItems
.DataOpen
With .Data
.AddNew
vID = !ID
!ID_Package = vPkg
.Update
End With
.DataShut
End With
End Sub
Public Sub CopyOrderItem(iData As clsOrderItem)
' ACTION: fills in the appropriate data in this object with information from the given order item
' USAGE: used for creating a new package from an order
With iData
' get the item to be shipped, and the order item it's shipping from
Me.Item_ID = .Item_ID
Me.OrderItem_ID = .ID
' (2004-01-16) we used to assume everything would ship; now we check stock first.
' ' assume we'll be shipping everything not nailed down... I mean, not already accounted for
' Me.QtyShipped = .QtyOrd - .QtyDone
' other quantities default to NULL
End With
Me.Save
End Sub
Public Sub Ship()
' ACTION: ships this item. This used to involve adjusting a quantity in the Order Item record, but for now it does nothing.
' If there is no corresponding order item, does nothing too.
' Dim objOrdItm As clsOrderItem

' If Me.OrderItemExists Then
' Set objOrdItm = Me.OrderItem
' With objOrdItm
' .QtyDoneAdd Me.QtyHandled + Me.QtyNotAvail + Me.QtyCancelled
' .Save
' End With
' End If
End Sub
Public Sub UnShip()
' ACTION: UNships this item, i.e. reverses the action of Ship()
' If there is no corresponding order item, does nothing
' Dim objOrdItm As clsOrderItem
'
' If Me.OrderItemExists Then
' Set objOrdItm = Me.OrderItem
' With objOrdItm
' .QtyDoneDel Me.QtyHandled + Me.QtyNotAvail + Me.QtyCancelled
' .Save
' End With
' End If
End Sub
Public Function Delete() As Boolean
With clsPackageItems
.DataOpen
If Located Then
.Data.Delete
Delete = True
Else
Delete = False
End If
End With
End Function
Public Sub Save()
With clsPackageItems
.DataOpen
If Located Then
With .Data
.Edit
!ID_Package = vPkg
!ID_Item = vItem
!ID_OrderItem = IIf(vOrdItem = 0, Null, vOrdItem)
!QtyShipped = vQtyShipped
!QtyExtra = vQtyExtra
!QtyNotAvail = vQtyNotAvail
!QtyCancelled = vQtyCancelled
.Update
End With
End If
End With
End Sub
Public Property Get ID() As Long
ID = vID
End Property
Public Property Get Package_ID() As Long
Package_ID = vPkg
End Property
Public Property Get PackageExists() As Boolean
PackageExists = (vPkg <> 0)
End Property
Public Property Get Package() As clsPackage
Dim objPkg As clsPackage

Set objPkg = clsPackages.Item(Me.Package_ID)
If objPkg Is Nothing Then
With clsPackages
.DataOpen
.Data.Requery
Set objPkg = .Item(Me.Package_ID)
.DataShut
End With
End If
Set Package = objPkg
End Property
Public Property Get Item_ID() As Long
Item_ID = vItem
End Property
Public Property Let Item_ID(iID As Long)
vItem = iID
End Property
Public Property Get Item() As clsItem
Set Item = clsItems.Item(Me.Item_ID)
End Property
Public Property Get OrderItem_ID() As Long
OrderItem_ID = vOrdItem
End Property
Public Property Let OrderItem_ID(iID As Long)
vOrdItem = iID
End Property
Public Property Get OrderItem() As clsOrderItem
Set OrderItem = clsOrderItems.Item(vOrdItem)
End Property
Public Property Get OrderItemExists() As Boolean
If (Me.OrderItem_ID = 0) Then
OrderItemExists = False
Else
OrderItemExists = Not (Me.OrderItem Is Nothing)
End If
End Property
Public Property Get QtyShipped() As Long
QtyShipped = vQtyShipped
End Property
Public Property Let QtyShipped(iQty As Long)
vQtyShipped = iQty
End Property
Public Property Get QtyMoved() As Long
' RETURNS: quantity shipped + quantity extra
QtyMoved = vQtyShipped + vQtyExtra
End Property
Public Sub AddQtyShipped(iQty As Long)
vQtyShipped = vQtyShipped + iQty
End Sub
Public Property Get QtyNotAvail() As Long
QtyNotAvail = Nz(vQtyNotAvail)
End Property
Public Property Let QtyNotAvail(iQty As Long)
vQtyNotAvail = iQty
End Property
Public Property Get QtyCancelled() As Long
QtyCancelled = Nz(vQtyCancelled)
End Property
Public Property Let QtyCancelled(iQty As Long)
vQtyCancelled = iQty
End Property
Public Property Get QtyCancelledEver() As Long
' ACTION: returns the total cancelled of this item for all packages started prior to this one
Dim objList As Scripting.Dictionary
Dim objItem As clsPackageItem
Dim dtStart As Date, dtItem As Date
Dim didFinish As Boolean
Dim doCount As Boolean
Dim qtyTot As Long

Set objList = Me.Packings
With Me.Package
didFinish = .HasBeenFinished
If didFinish Then
dtStart = .WhenFinished
End If
End With

If objList Is Nothing Then
QtyCancelledEver = 0
Else
For Each objItem In objList
With objItem
dtItem = .Package.WhenStarted
If didFinish Then
doCount = (dtItem < dtStart)
Else
doCount = False
End If
If doCount Then
qtyTot = qtyTot + .QtyCancelled
End If
End With
Next objItem
QtyCancelledEver = qtyTot
End If
End Property
Public Property Get QtyHandled() As Long
QtyHandled = QtyShipped + QtyNotAvail + QtyCancelled
End Property
Public Property Get QtyOpen() As Long
With Me.OrderItem
QtyOpen = .QtyRem
End With
End Property
Public Property Get QtyOrdered() As Long
' ACTION: returns the quantity originally ordered for the current item
With Me.OrderItem
QtyOrdered = .QtyOrd
End With
End Property
Public Property Get QtyYetToPack() As Long
' ACTION: returns the quantity not packed earlier than this package's creation date
' STEPS:
' 1. get all package items referring to the same Order Item
' 2. total the ones whose package is dated earlier than this package
' 3. subtract from the total ordered; return this result.
Dim objPkg As clsPackage
Dim dtStart As Date, dtItem As Date
Dim objList As Scripting.Dictionary
Dim objItem As clsPackageItem
Dim qtyPkd As Long

Set objPkg = Me.Package
If objPkg Is Nothing Then
QtyYetToPack = 0
Debug.Print "Package object not returned for ID=" & Me.Package_ID
Else
dtStart = objPkg.WhenStarted
Set objList = Me.Packings

If objList Is Nothing Then
QtyYetToPack = 0
Else
For Each objItem In objList
With objItem
If .PackageExists Then
If .Package Is Nothing Then
MsgBox "Package ID=" & .Package_ID & " could not be loaded.", vbCritical, "Internal Error"
Else
dtItem = .Package.WhenStarted
If dtItem < dtStart Then
qtyPkd = qtyPkd + .QtyHandled
End If
End If
End If
End With
Next objItem
QtyYetToPack = Me.OrderItem.QtyOrd - qtyPkd
End If
End If
End Property
Public Property Get WasOrdered() As Boolean
WasOrdered = (Me.OrderItem_ID <> 0)
End Property
'Public Property Get Item() As clsItem
'' ACTION: returns the package item's item object, if available, else pops up error messages and allows the user
'' to enter missing data.
' Dim objItRef As clsItemRef
' Dim objItem As clsItem
'
' Set objItRef = Me.ItRef
' If objItRef Is Nothing Then
' MsgBox "An item in the package has no item reference.", vbExclamation, "Data Missing"
' Else
' Set objItem = objItRef.Item
' If objItem Is Nothing Then
' With objItRef
' MsgBox "The item reference " & .DescrText & " (" & .CatNum & ") has no item assigned.", vbExclamation, "Data Missing"
' .Edit
' doCancel = True ' cancel the rest of the operation
' End With
' Else
' Set Item = objItem
' End If
' End If
'End Property
Public Property Get ShipCode_Exists() As Boolean
Dim objItem As clsItem

Set objItem = Me.Item
If objItem Is Nothing Then Exit Property
ShipCode_Exists = objItem.ShipCodeExists
End Property
Public Property Get ShipCode() As clsShipCode
' ACTION: returns the package item's ship code object, if available, else pops up error messages and allows the user
' to enter missing data.
Dim objItem As clsItem
Dim objShip As clsShipCode

Set objItem = Me.Item
If objItem Is Nothing Then Exit Property
Set objShip = objItem.ShipCode
If objShip Is Nothing Then
With objItem
MsgBox "The item " & .Description & " (" & .CatNum & ") has no shipping code set."
.Edit
doCancel = True ' cancel the rest of the operation
End With
Set ShipCode = Nothing
Else
Set ShipCode = objShip
End If
End Property
Public Property Get PriceEffective() As Currency
' ACTION: returns the effective price of the item, which is the amount quoted in the order item record (if available)
' or else defaults to the item's current price
Dim objItem As clsItem
Dim objPrice As clsPriceCode

If Me.OrderItemExists Then
PriceEffective = Me.OrderItem.Price
Else
Set objItem = Me.Item
If objItem Is Nothing Then Exit Property
Set objPrice = objItem.PriceCode
If objPrice Is Nothing Then
With objItem
MsgBox "The item " & .Description & " (" & .CatNum & ") has no price code set."
.Edit
doCancel = True ' cancel the rest of the operation
End With
Else
PriceEffective = Me.Item.PriceCode.Price
End If
End If
End Property
Public Property Get ShipPkgEffective() As Currency
' ACTION: returns the effective shipping package cost of the item, which is the amount quoted in the order item record (if available)
' or else defaults to the value in the item's current shipping code
Dim objShip As clsShipCode

If Me.OrderItemExists Then
ShipPkgEffective = Me.OrderItem.ShipPkg
Else
Set objShip = Me.ShipCode
If objShip Is Nothing Then Exit Property
ShipPkgEffective = objShip.PerPkg
End If
End Property
Public Property Get ShipItmEffective() As Currency
' ACTION: returns the effective shipping per-item cost of the item, which is the amount quoted in the order item record (if available)
' or else defaults to the value in the item's current shipping code
Dim objShip As clsShipCode

If Me.OrderItemExists Then
ShipItmEffective = Me.OrderItem.ShipItem
Else
Set objShip = Me.ShipCode
If objShip Is Nothing Then Exit Property
ShipItmEffective = objShip.PerItem
End If
End Property
Public Property Get PriceTotal() As Currency
' ACTION: returns the item's effective price multiplied by the quantity being shipped
PriceTotal = Me.PriceEffective * Me.QtyShipped
End Property
Public Property Get ShipItemTotal() As Currency
' ACTION: returns the itemized shipping cost multiplied by the quantity being shipped
ShipItemTotal = Me.ShipItmEffective * Me.QtyShipped
End Property
Public Property Get Packings() As Scripting.Dictionary
' ACTION: returns a list of all packings of the same line item (including this object)
Dim objOItem As clsOrderItem

If Me.WasOrdered Then
Set objOItem = Me.OrderItem
If objOItem Is Nothing Then
Set Packings = Nothing
Else
Set Packings = objOItem.Packings
End If
Else
Set Packings = Nothing
End If
End Property
Private Function Located() As Boolean
Dim isFnd As Boolean

isFnd = True
With clsPackageItems
With .Data
If .EOF Then
isFnd = False
ElseIf !ID <> vID Then
.FindFirst "ID=" & vID
If .NoMatch Then
MsgBox "Package Item with ID=" & vID & " was not found.", vbCritical, "Internal Error"
isFnd = False
End If
End If
End With
End With
Located = isFnd
End Function
Public Sub FetchFromStockLine(iStkLine As Long, iQty As Long)
Dim objStkLine As clsStockItem

Set objStkLine = clsStockItems.Item(iStkLine)
If objStkLine Is Nothing Then Stop ' internal error
objStkLine.FetchToPkgLine iQty, Me.ID
End Sub
Public Sub FetchFromLocation(iLoc As Long, iQty As Long)
Dim sqlFilt As String
Dim objStkLine As clsStockItem

sqlFilt = "(ID_Location=" & iLoc & ") AND (ID_Item=" & Me.Item_ID & ")"
Set objStkLine = New clsStockItem
With clsStockItems
.DataOpen
With .Data
.FindFirst sqlFilt
Do While Not .NoMatch
objStkLine.Init .Fields, clsStockItems
objStkLine.FetchToPkgLine iQty, Me.ID
.FindNext sqlFilt
Loop
End With
.DataShut
End With
End Sub
</VB>

VbzCart/archive/code/VBA/clsPackageItem - Revision history

Woozle at 12:48, 14 October 2022

Woozle: Woozle moved page VbzCart/code/VBA/clsPackageItem to VbzCart/archive/code/VBA/clsPackageItem

Woozle: Created page with " ' CLASS: clsPackageItem Option Compare Database Option Explicit Private vID As Long Private vPkg As Long Private vItem As Long Private vOrdItem As Long Private vQtyShipp..."