Difference between revisions of "VbzCart/archive/code/VBA/clsPackages"

from HTYP, the free directory anyone can edit if they can prove to me that they're not a spambot
< VbzCart‎ | archive‎ | code‎ | VBA
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
</VB>
+
</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