VbzCart/archive/code/VBA/clsPackageItem

from HTYP, the free directory anyone can edit if they can prove to me that they're not a spambot
Jump to navigation Jump to search

<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>

Retrieved from "https://htyp.org/mw/index.php?title=VbzCart/archive/code/VBA/clsPackageItem&oldid=20368"