VbzCart/archive/code/VBA/clsPackages
Jump to navigation
Jump to search
' 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