Product Class Object
Option Explicit
'Use with SQL
'Expects Stored Procedures Based Data Object
'Template Requires CheckNull Function for Null Values
'Template Requires pre-created adoConnection Object in variable Conn
'Date/Time Created - 4/13/2020 12:39:16 AM
' Private constants
Private Const ltUPDATE = 0
Private Const ltINSERT = 1
Private Const ltDELETE = 2
'Private Property Variables
Private m_ProductID As Long
Private m_Active As Boolean
Private m_DepID As Integer
Private m_PackID As Integer
Private m_ProdFacingText As String
Private m_ProdDescription As String
Private m_CustomText1 As String
Private m_CustomText2 As String
Private m_CustomText3 As String
Private m_CustomText4 As String
Private m_CustomNum1 As Integer
Private m_CustomNum2 As Integer
Private m_CustomNum3 As Integer
Private m_CustomNum4 As Integer
Private m_TaktTime As Double
Private m_GTINNum As String
Private m_MRPNum As String
Private m_ProdFamily As Integer
'Primary Key
Private mudtPrimaryKey As PrimaryKey
Private Type PrimaryKey
ProductID As Long
End Type
'Common Private Property Variables
Private m_intStatus As String ' insert, Update or Delete
Private m_bolIsDirty As Boolean ' has object's data changed?
Private m_strErrDesc As String ' string value of last error
Private Const m_strCLASS_ID = "Product"
'Public Property LETS/GETS
'Primary Key
Public Property Get PK(ByVal vsProductID As Long) As Variant
Select Case vsProductID
Case Is = 0
PK = mudtPrimaryKey.ProductID
Case Else
Err.Raise vbObjectError + 3001, m_strCLASS_ID, "Case Else Error on PK retrieval"
End Select
End Property
Public Property Let ProductID(Vdata As Long)
'ProductID
m_bolIsDirty = IIf(HasVarChanged(m_ProductID, Vdata), True, m_bolIsDirty)
m_ProductID = Vdata
End Property
Public Property Get ProductID() As Long
ProductID = m_ProductID
End Property
Public Property Let Active(Vdata As Boolean)
'Active
m_bolIsDirty = IIf(HasVarChanged(m_Active, Vdata), True, m_bolIsDirty)
m_Active = Vdata
End Property
Public Property Get Active() As Boolean
Active = m_Active
End Property
Public Property Let DepID(Vdata As Integer)
'DepID
m_bolIsDirty = IIf(HasVarChanged(m_DepID, Vdata), True, m_bolIsDirty)
m_DepID = Vdata
End Property
Public Property Get DepID() As Integer
DepID = m_DepID
End Property
Public Property Let PackID(Vdata As Integer)
'PackID
m_bolIsDirty = IIf(HasVarChanged(m_PackID, Vdata), True, m_bolIsDirty)
m_PackID = Vdata
End Property
Public Property Get PackID() As Integer
PackID = m_PackID
End Property
Public Property Let ProdFacingText(Vdata As String)
'ProdFacingText
m_bolIsDirty = IIf(HasVarChanged(m_ProdFacingText, Vdata), True, m_bolIsDirty)
m_ProdFacingText = Vdata
End Property
Public Property Get ProdFacingText() As String
ProdFacingText = m_ProdFacingText
End Property
Public Property Let ProdDescription(Vdata As String)
'ProdDescription
m_bolIsDirty = IIf(HasVarChanged(m_ProdDescription, Vdata), True, m_bolIsDirty)
m_ProdDescription = Vdata
End Property
Public Property Get ProdDescription() As String
ProdDescription = m_ProdDescription
End Property
Public Property Let GTINNum(Vdata As String)
'GTINNum
m_bolIsDirty = IIf(HasVarChanged(m_GTINNum, Vdata), True, m_bolIsDirty)
m_GTINNum = Vdata
End Property
Public Property Get GTINNum() As String
GTINNum = m_GTINNum
End Property
Public Property Let MRPNum(Vdata As String)
'MRPNum
m_bolIsDirty = IIf(HasVarChanged(m_MRPNum, Vdata), True, m_bolIsDirty)
m_MRPNum = Vdata
End Property
Public Property Get MRPNum() As String
MRPNum = m_MRPNum
End Property
Public Property Let CustomText1(Vdata As String)
'CustomText1
m_bolIsDirty = IIf(HasVarChanged(m_CustomText1, Vdata), True, m_bolIsDirty)
m_CustomText1 = Vdata
End Property
Public Property Get CustomText1() As String
CustomText1 = m_CustomText1
End Property
Public Property Let CustomText2(Vdata As String)
'CustomText2
m_bolIsDirty = IIf(HasVarChanged(m_CustomText2, Vdata), True, m_bolIsDirty)
m_CustomText2 = Vdata
End Property
Public Property Get CustomText2() As String
CustomText2 = m_CustomText2
End Property
Public Property Let CustomText3(Vdata As String)
'CustomText3
m_bolIsDirty = IIf(HasVarChanged(m_CustomText3, Vdata), True, m_bolIsDirty)
m_CustomText3 = Vdata
End Property
Public Property Get CustomText3() As String
CustomText3 = m_CustomText3
End Property
Public Property Let CustomText4(Vdata As String)
'CustomText4
m_bolIsDirty = IIf(HasVarChanged(m_CustomText4, Vdata), True, m_bolIsDirty)
m_CustomText4 = Vdata
End Property
Public Property Get CustomText4() As String
CustomText4 = m_CustomText4
End Property
Public Property Let CustomNum1(Vdata As Integer)
'CustomNum1
m_bolIsDirty = IIf(HasVarChanged(m_CustomNum1, Vdata), True, m_bolIsDirty)
m_CustomNum1 = Vdata
End Property
Public Property Get CustomNum1() As Integer
CustomNum1 = m_CustomNum1
End Property
Public Property Let CustomNum2(Vdata As Integer)
'CustomNum2
m_bolIsDirty = IIf(HasVarChanged(m_CustomNum2, Vdata), True, m_bolIsDirty)
m_CustomNum2 = Vdata
End Property
Public Property Get CustomNum2() As Integer
CustomNum2 = m_CustomNum2
End Property
Public Property Let ProdFamily(Vdata As Integer)
'ProdFamily
m_bolIsDirty = IIf(HasVarChanged(m_ProdFamily, Vdata), True, m_bolIsDirty)
m_ProdFamily = Vdata
End Property
Public Property Get ProdFamily() As Integer
ProdFamily = m_ProdFamily
End Property
Public Property Let TaktTime(Vdata As Double)
'TaktTime
m_bolIsDirty = IIf(HasVarChanged(m_TaktTime, Vdata), True, m_bolIsDirty)
m_TaktTime = Vdata
End Property
Public Property Get TaktTime() As Double
TaktTime = m_TaktTime
End Property
Public Property Let CustomNum3(Vdata As Integer)
'CustomNum3
m_bolIsDirty = IIf(HasVarChanged(m_CustomNum3, Vdata), True, m_bolIsDirty)
m_CustomNum3 = Vdata
End Property
Public Property Get CustomNum3() As Integer
CustomNum3 = m_CustomNum3
End Property
Public Property Let CustomNum4(Vdata As Integer)
'CustomNum4
m_bolIsDirty = IIf(HasVarChanged(m_CustomNum4, Vdata), True, m_bolIsDirty)
m_CustomNum4 = Vdata
End Property
Public Property Get CustomNum4() As Integer
CustomNum4 = m_CustomNum4
End Property
Private Function Exec_prc_ins_Product() As Long
Dim sSQL As String
Dim CMD As ADODB.Command
Dim nRowsAffected As Long
On Error GoTo PROC_ERR
sSQL = "INSERT INTO Product ("
'sSQL = sSQL & " ProductID,"
sSQL = sSQL & " Active,"
sSQL = sSQL & " DepID,"
sSQL = sSQL & " PackID,"
sSQL = sSQL & " ProdFamily,"
sSQL = sSQL & " ProdFacingText,"
sSQL = sSQL & " ProdDescription,"
sSQL = sSQL & " TaktTime,"
sSQL = sSQL & " GTINNum,"
sSQL = sSQL & " MRPNum,"
sSQL = sSQL & " CustomText1,"
sSQL = sSQL & " CustomText2,"
sSQL = sSQL & " CustomText3,"
sSQL = sSQL & " CustomText4,"
sSQL = sSQL & " CustomNum1,"
sSQL = sSQL & " CustomNum2,"
sSQL = sSQL & " CustomNum3,"
sSQL = sSQL & " CustomNum4"
sSQL = sSQL & ") VALUES ("
'sSQL = sSQL & m_ProductID & ","
sSQL = sSQL & FormatSQL(m_Active, 0) & ","
sSQL = sSQL & m_DepID & ","
sSQL = sSQL & m_PackID & ","
sSQL = sSQL & m_ProdFamily & ","
sSQL = sSQL & "'" & m_ProdFacingText & "'" & ","
sSQL = sSQL & "'" & m_ProdDescription & "'" & ","
sSQL = sSQL & m_TaktTime & ","
sSQL = sSQL & "'" & m_GTINNum & "'" & ","
sSQL = sSQL & "'" & m_MRPNum & "'" & ","
sSQL = sSQL & "'" & m_CustomText1 & "'" & ","
sSQL = sSQL & "'" & m_CustomText2 & "'" & ","
sSQL = sSQL & "'" & m_CustomText3 & "'" & ","
sSQL = sSQL & "'" & m_CustomText4 & "'" & ","
sSQL = sSQL & m_CustomNum1 & ","
sSQL = sSQL & m_CustomNum2 & ","
sSQL = sSQL & m_CustomNum3 & ","
sSQL = sSQL & m_CustomNum4
sSQL = sSQL & ")"
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = Conn
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
Exec_prc_ins_Product = 0
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Exec_prc_ins_Product Error " & Err.Number & " Description " & Err.Description
Exec_prc_ins_Product = Err.Number
End Function
Private Function Exec_prc_sel_Product() As ADODB.Recordset
Dim sSQL As String
Dim rs As ADODB.Recordset
On Error GoTo PROC_ERR
sSQL = "SELECT"
sSQL = sSQL & " ProductID,"
sSQL = sSQL & " Active,"
sSQL = sSQL & " DepID,"
sSQL = sSQL & " PackID,"
sSQL = sSQL & " ProdFamily,"
sSQL = sSQL & " ProdFacingText,"
sSQL = sSQL & " ProdDescription,"
sSQL = sSQL & " TaktTime,"
sSQL = sSQL & " GTINNum,"
sSQL = sSQL & " MRPNum,"
sSQL = sSQL & " CustomText1,"
sSQL = sSQL & " CustomText2,"
sSQL = sSQL & " CustomText3,"
sSQL = sSQL & " CustomText4,"
sSQL = sSQL & " CustomNum1,"
sSQL = sSQL & " CustomNum2,"
sSQL = sSQL & " CustomNum3,"
sSQL = sSQL & " CustomNum4"
sSQL = sSQL & " FROM Product"
sSQL = sSQL & " WHERE"
sSQL = sSQL & " ProductID = " & m_ProductID
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = Conn
rs.Open sSQL
Set Exec_prc_sel_Product = rs
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Exec_prc_sel_Product Error " & Err.Number & " Description " & Err.Description
End Function
Private Function Exec_prc_upd_Product() As Long
Dim sSQL As String
Dim nRowsAffected As Long
Dim CMD As ADODB.Command
On Error GoTo PROC_ERR
sSQL = "UPDATE Product "
sSQL = sSQL & " SET"
'sSQL = sSQL & " ProductID = " & m_ProductID & ","
sSQL = sSQL & " Active = " & FormatSQL(m_Active, 0) & ","
sSQL = sSQL & " DepID = " & m_DepID & ","
sSQL = sSQL & " PackID = " & m_PackID & ","
sSQL = sSQL & " ProdFamily = " & m_ProdFamily & ","
sSQL = sSQL & " ProdFacingText = " & "'" & m_ProdFacingText & "'" & ","
sSQL = sSQL & " ProdDescription = " & "'" & m_ProdDescription & "'" & ","
sSQL = sSQL & " TaktTime = " & m_TaktTime & ","
sSQL = sSQL & " GTINNum = " & "'" & m_GTINNum & "'" & ","
sSQL = sSQL & " MRPNum = " & "'" & m_MRPNum & "'" & ","
sSQL = sSQL & " CustomText1 = " & "'" & m_CustomText1 & "'" & ","
sSQL = sSQL & " CustomText2 = " & "'" & m_CustomText2 & "'" & ","
sSQL = sSQL & " CustomText3 = " & "'" & m_CustomText3 & "'" & ","
sSQL = sSQL & " CustomText4 = " & "'" & m_CustomText4 & "'" & ","
sSQL = sSQL & " CustomNum1 = " & m_CustomNum1 & ","
sSQL = sSQL & " CustomNum2 = " & m_CustomNum2 & ","
sSQL = sSQL & " CustomNum3 = " & m_CustomNum3 & ","
sSQL = sSQL & " CustomNum4 = " & m_CustomNum4 & ""
sSQL = sSQL & " WHERE"
sSQL = sSQL & " ProductID = " & m_ProductID
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = Conn
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
Exec_prc_upd_Product = 0
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Exec_prc_upd_Product Error " & Err.Number & " Description " & Err.Description
Exec_prc_upd_Product = Err.Number
End Function
Private Function Exec_prc_del_Product() As Long
Dim sSQL As String
Dim nRowsAffected As Long
Dim CMD As ADODB.Command
On Error GoTo PROC_ERR
sSQL = "DELETE FROM Product "
sSQL = sSQL & " WHERE"
sSQL = sSQL & " ProductID = " & m_ProductID
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = Conn
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
Exec_prc_del_Product = 0
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Exec_prc_del_Product Error " & Err.Number & " Description " & Err.Description
Exec_prc_del_Product = Err.Number
End Function
Public Function Find() As Long
Dim lngRetVal As Long
Dim rs As ADODB.Recordset
On Error GoTo PROC_ERR
Set rs = Exec_prc_sel_Product()
If lngRetVal <> 0 Then
GoTo PROC_EXIT
ElseIf IsEmpty(rs) Then
Find = vbObjectError + 3002
m_strErrDesc = "Empty Recordset"
GoTo PROC_EXIT
ElseIf rs.BOF And rs.EOF Then ' no records returned
lngRetVal = vbObjectError + 3003
m_strErrDesc = "Record not found"
GoTo PROC_EXIT
Else
If IsNull(rs("ProductID")) Then '<-- Check If null ProductID
m_ProductID = 0
Else
m_ProductID = rs("ProductID")
End If
If IsNull(rs("Active")) Then '<-- Check If null Active
m_Active = -1
Else
m_Active = rs("Active")
End If
If IsNull(rs("DepID")) Then '<-- Check If null DepID
m_DepID = 0
Else
m_DepID = rs("DepID")
End If
If IsNull(rs("ProdFamily")) Then '<-- Check If null ProdFamily
m_ProdFamily = 0
Else
m_ProdFamily = rs("ProdFamily")
End If
If IsNull(rs("PackID")) Then '<-- Check If null PackID
m_PackID = 0
Else
m_PackID = rs("PackID")
End If
If IsNull(rs("ProdFacingText")) Then '<-- Check If null ProdFacingText
m_ProdFacingText = ""
Else
m_ProdFacingText = rs("ProdFacingText")
End If
If IsNull(rs("GTINNum")) Then '<-- Check If null GTINNum
m_GTINNum = ""
Else
m_GTINNum = rs("GTINNum")
End If
If IsNull(rs("MRPNum")) Then '<-- Check If null MRPNum
m_MRPNum = ""
Else
m_MRPNum = rs("MRPNum")
End If
If IsNull(rs("ProdDescription")) Then '<-- Check If null ProdDescription
m_ProdDescription = ""
Else
m_ProdDescription = rs("ProdDescription")
End If
If IsNull(rs("TaktTime")) Then '<-- Check If null TaktTime
m_TaktTime = 0
Else
m_TaktTime = rs("TaktTime")
End If
If IsNull(rs("CustomText1")) Then '<-- Check If null CustomText1
m_CustomText1 = ""
Else
m_CustomText1 = rs("CustomText1")
End If
If IsNull(rs("CustomText2")) Then '<-- Check If null CustomText2
m_CustomText2 = ""
Else
m_CustomText2 = rs("CustomText2")
End If
If IsNull(rs("CustomText3")) Then '<-- Check If null CustomText3
m_CustomText3 = ""
Else
m_CustomText3 = rs("CustomText3")
End If
If IsNull(rs("CustomText4")) Then '<-- Check If null CustomText4
m_CustomText4 = ""
Else
m_CustomText4 = rs("CustomText4")
End If
If IsNull(rs("CustomNum1")) Then '<-- Check If null CustomNum1
m_CustomNum1 = 0
Else
m_CustomNum1 = rs("CustomNum1")
End If
If IsNull(rs("CustomNum2")) Then '<-- Check If null CustomNum2
m_CustomNum2 = 0
Else
m_CustomNum2 = rs("CustomNum2")
End If
If IsNull(rs("CustomNum3")) Then '<-- Check If null CustomNum3
m_CustomNum3 = 0
Else
m_CustomNum3 = rs("CustomNum3")
End If
If IsNull(rs("CustomNum4")) Then '<-- Check If null CustomNum4
m_CustomNum4 = 0
Else
m_CustomNum4 = rs("CustomNum4")
End If
End If '<---End Set rs
rs.Close
Set rs = Nothing
' Load Primary Key value(s)
mudtPrimaryKey.ProductID = m_ProductID
m_bolIsDirty = False ' Set this flag to False because a New object is always Clean
m_intStatus = ltUPDATE
PROC_EXIT:
Find = lngRetVal ' Set the return code to the return code from the txn object method and exit the function
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Find() Error " & Err.Number & " Description " & Err.Description
Find = Err.Number
End Function
'GENERIC PROPERTY VARIABLES
Public Property Get ClassID() As String
ClassID = m_strCLASS_ID
End Property
'IsDirty
Public Property Get IsDirty() As Boolean
IsDirty = m_bolIsDirty
End Property
Public Property Let IsDirty(Vdata As Boolean)
m_bolIsDirty = Vdata
End Property
'Status
Public Property Get Status() As Integer
Status = m_intStatus
End Property
Public Property Let Status(Vdata As Integer)
m_intStatus = Vdata
End Property
'Error Description
Public Property Get ErrorDesc() As String
ErrorDesc = m_strErrDesc
End Property
Private Function HasVarChanged(val1 As Variant, val2 As Variant) As Boolean
HasVarChanged = True
' If either of the values is a NULL check to make sure that they are NOT
' both NULLs In this case the comparison would result in NULL and not =;
If IsNull(val1) Or IsNull(val2) Then
If IsNull(val1) And IsNull(val2) Then
HasVarChanged = False
Exit Function
End If
End If
If val1 = val2 Then
HasVarChanged = False
End If
End Function
Private Sub Class_Initialize()
m_intStatus = ltINSERT
End Sub
Public Function Delete() As Long
Dim lngRetVal As Long
m_intStatus = ltDELETE
lngRetVal = Update
Delete = lngRetVal
End Function
Public Function Update() As Long
On Error GoTo PROC_ERR
Dim lngRetVal As Long
' Skip if this Object is being updated but it is unchanged since last update;
If (m_bolIsDirty = False And m_intStatus = ltUPDATE) Then
GoTo PROC_EXIT
End If
If m_intStatus = ltINSERT Then
lngRetVal = Exec_prc_ins_Product() '<- Private Procs
ElseIf m_intStatus = ltUPDATE Then
lngRetVal = Exec_prc_upd_Product() '<- Private Procs
Else
lngRetVal = Exec_prc_del_Product() '<- Private Procs
End If
If lngRetVal <> 0 Then
' An error occurred
GoTo PROC_EXIT
End If
' A new record that has been Inserted becomes and existing record
' that will be Updtated next time
If m_intStatus = ltINSERT Then m_intStatus = ltUPDATE
PROC_EXIT:
Update = lngRetVal ' Set the return code to the return code from the txn object method and exit the function
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Update() Error " & Err.Number & " Description " & Err.Description
Update = Err.Number
End Function
Public Function LoadList2(lngDepID As Long, ProdID As Long) As ADODB.Recordset
Dim sSQL As String
Dim rs As ADODB.Recordset
On Error GoTo PROC_ERR
sSQL = "SELECT a.Active, a.ProdID, a.DepID, a.ProdFacingText, a.PackID, b.UomID, b.UomCount, b.UomText"
sSQL = sSQL & " FROM (Product a LEFT JOIN UOMTable b ON a.PackID = b.UomID)"
sSQL = sSQL & " WHERE a.DepID = " & lngDepID
sSQL = sSQL & " AND a.ProductID = " & ProdID
'sSQL = sSQL & " AND a.Active = " & FormatSQL(True, 0)
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = Conn
rs.Open sSQL
Set LoadList2 = rs
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Function LoadList() Error " & Err.Number & " Description " & Err.Description
End Function
Public Function LoadList(lngDepID As Long) As ADODB.Recordset
Dim sSQL As String
Dim rs As ADODB.Recordset
On Error GoTo PROC_ERR
sSQL = "SELECT a.ProductID, a.Active, a.ProdDescription, a.DepID, a.ProdFacingText, a.PackID, a.GTINNum, a.MRPNum, b.UomID, b.UomCount, b.UomText"
sSQL = sSQL & " FROM (Product a LEFT JOIN UOMTable b ON a.PackID = b.UomID)"
sSQL = sSQL & " WHERE a.DepID = " & lngDepID
'sSQL = sSQL & " AND a.Active = " & FormatSQL(True, 0)
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = Conn
rs.Open sSQL
Set LoadList = rs
Exit Function
PROC_ERR:
m_strErrDesc = "Class Product Function LoadList() Error " & Err.Number & " Description " & Err.Description
'Debug.Print sSQL
'Debug.Print m_strErrDesc
End Function
Share This
