Woozle at 12:47, 14 October 2022

2022-10-14T12:47:33Z

← Older revision		Revision as of 12:47, 14 October 2022
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>

Woozle: Woozle moved page VbzCart/code/VBA/clsPackages to VbzCart/archive/code/VBA/clsPackages

2014-12-19T02:09:01Z

Woozle moved page VbzCart/code/VBA/clsPackages to VbzCart/archive/code/VBA/clsPackages

← Older revision	Revision as of 02:09, 19 December 2014
(No difference)

Woozle: Created page with " ' CLASS: clsPackages Option Compare Database Option Explicit Private rs As Recordset Private intAccessCount As Long Public Sub Init() intAccessCount = 0 Set rs ..."

2014-05-08T00:47:12Z

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 ..."

New page

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

VbzCart/archive/code/VBA/clsPackages - Revision history

Woozle at 12:47, 14 October 2022

Woozle: Woozle moved page VbzCart/code/VBA/clsPackages to VbzCart/archive/code/VBA/clsPackages

Woozle: Created page with " ' CLASS: clsPackages Option Compare Database Option Explicit Private rs As Recordset Private intAccessCount As Long Public Sub Init() intAccessCount = 0 Set rs ..."