VbzCart/docs/archive/code/VBA/clsPackages

' 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 Sub DataOpen()
    If intAccessCount = 0 Then
        Set rs = CurrentDb.OpenRecordset("Packages", 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 clsPackage
    Dim objItem As clsPackage

    Me.DataOpen
    With Me.Data
        .FindFirst "ID=" & iID
        If .NoMatch Then
            Set objItem = Nothing
'            MsgBox "Package ID " & iID & " not found", vbCritical, "Internal Error"
        Else
            Set objItem = New clsPackage
            objItem.Init .Fields
        End If
    End With
    Me.DataShut
    Set Item = objItem
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
        !Seq = intCode
        !WhenStarted = Now
        !ID_Shipment = clsShipments.FirstOpen_ID
        objNew.Init .Fields
        .Update
    End With
    Me.DataShut
    Set Create = objNew
End Function