Difference between revisions of "VbzCart/archive/code/VBA/clsPackages"
Jump to navigation
Jump to search
(Created page with "<VB> ' CLASS: clsPackages Option Compare Database Option Explicit Private rs As Recordset Private intAccessCount As Long Public Sub Init() intAccessCount = 0 Set rs ...") |
m |
||
(One intermediate revision by the same user not shown) | |||
Line 1: | Line 1: | ||
− | <VB> | + | <syntaxhighlight lang=VB> |
' CLASS: clsPackages | ' CLASS: clsPackages | ||
Line 76: | Line 76: | ||
Set Create = objNew | Set Create = objNew | ||
End Function | End Function | ||
− | </ | + | </syntaxhighlight> |
Latest revision as of 12:47, 14 October 2022
' 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