View source for VbzCart/docs/archive/code/VBA/clsPackageItems

syntaxhighlight lang=<VB>
' CLASS: clsPackages

Option Compare Database
Option Explicit

Private rs As Recordset
Private intAccessCount As Long
Public Sub Init()
    intAccessCount = 0
    Set rs = Nothing
End Sub
Public Property Get Data() As Recordset
    Set Data = rs
End Property
Public Property Get Data_Items() As Recordset
'    Set Data_Items = CurrentDb.OpenRecordset("qryPkgItems_Items", dbOpenSnapshot)
    Set Data_Items = CurrentDb.OpenRecordset("Package Items", dbOpenSnapshot)
End Property
Public Sub DataOpen()
    If intAccessCount = 0 Then
        Set rs = CurrentDb.OpenRecordset("Package Items", dbOpenDynaset)
    End If
    intAccessCount = intAccessCount + 1
End Sub
Public Sub DataShut()
    intAccessCount = intAccessCount - 1
    If intAccessCount = 0 Then
        rs.Close
        Set rs = Nothing
    End If
End Sub
Public Property Get Item(iID As Long) As clsPackageItem
    Dim objItem As clsPackageItem

    Me.DataOpen
    With Me.Data
        .FindFirst "ID=" & iID
        If .NoMatch Then
'            MsgBox "Package ID " & iID & " not found", vbCritical, "Internal Error"
            Set objItem = Nothing
        Else
            Set objItem = New clsPackageItem
            objItem.Init .Fields
        End If
    End With
    Me.DataShut
    Set Item = objItem
End Property
Public Property Get Packings(iOrderItem As Long) As Scripting.Dictionary
' ACTION: returns a list of all packings of the given order item
    Dim strFilt As String
    Dim objList As Scripting.Dictionary
    Dim objItem As clsPackageItem

    strFilt = "ID_OrderItem=" & iOrderItem
    Set objList = New Scripting.Dictionary
    Me.DataOpen
    With Me.Data
        .FindFirst strFilt
        Do Until .NoMatch
            Set objItem = New clsPackageItem
            objItem.Init .Fields
            objList.Add objItem, objItem.ID
            .FindNext strFilt
        Loop
    End With
    Me.DataShut
    Set Packings = objList
End Property
'Public Function Create(iOrder As Long) As clsPackage
'' ACTION: create a new package record/object
'    Dim objNew As clsPackage
'    Dim intCode As Long
'    Dim strFilt As String
'
'    Set objNew = New clsPackage
'    Me.DataOpen
'    With Me.Data
'        ' find the highest used package code
'        strFilt = "ID_Order=" & iOrder
'        .FindFirst strFilt
'        Do Until .NoMatch
'            If intCode < !Seq Then
'                intCode = !Seq
'            End If
'            .FindNext strFilt
'        Loop
'        intCode = intCode + 1   ' then increment it by one
'
'        ' now create the new record
'        .AddNew
'        !ID_Order = iOrder
'        !Code = intCode
'        !WhenStarted = Now
'        .Update
'        objNew.Init .Fields
'    End With
'    Me.DataShut
'    Set Create = objNew
'End Function
</syntaxhighlight>