VbzCart/docs/archive/code/VBA/clsPackages

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