📄 timecardexpense.cls
字号:
'* Purpose: Delete record in database based on a where SQL clause. *
'* Note it doesn't delete children records. *
'* *
'******************************************************************************
Public Function DeleteList(ByVal strDeleteSQL As String) As Boolean
On Error GoTo Err_DeleteList
Dim strSQL As String
strSQL = "DELETE * FROM [Time Card Expenses] " & strDeleteSQL
Conn.Execute strSQL
DeleteList = True
Exit Function
Err_DeleteList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCardExpense","DeleteList")
End Function
'******************************************************************************
'* *
'* Name: Load *
'* *
'* Purpose: Get the specified record. If found, fill this object with correct *
'* record data. GetChildren is optional so if true get children *
'* record as well. *
'* *
'* Returns: Boolean - True (record found); False (otherwise). *
'* *
'******************************************************************************
Public Function Load(ByVal vTimeCardExpenseID As Long) As Boolean
On Error GoTo Err_Load
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Clear
strSQL = "Select a.ExpenseAmount,a.ExpenseCodeID,b.ExpenseCode As ExpenseCode,a.ExpenseDescription,a.ProjectID,c.ProjectName As ProjectName,a.TimeCardExpenseID,a.TimeCardID,d.DateEntered As DateEntered,a.ExpenseDate From (([Time Card Expenses] a LEFT JOIN [Expense Codes] b ON a.ExpenseCodeID = b.ExpenseCodeID) LEFT JOIN Projects c ON a.ProjectID = c.ProjectID) LEFT JOIN [Time Cards] d ON a.TimeCardID = d.TimeCardID WHERE a.TimeCardExpenseID=" & vTimeCardExpenseID & ""
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
If Not .EOF Then
m_ExpenseAmount= IIF(IsNull(adoRS("ExpenseAmount")), 0, adoRS("ExpenseAmount"))
m_ExpenseCodeID= IIF(IsNull(adoRS("ExpenseCodeID")), 0, adoRS("ExpenseCodeID"))
m_ExpenseCode= IIF(IsNull(adoRS("ExpenseCode")), "", adoRS("ExpenseCode"))
m_ExpenseDescription= IIF(IsNull(adoRS("ExpenseDescription")), "", adoRS("ExpenseDescription"))
m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
m_TimeCardExpenseID= IIF(IsNull(adoRS("TimeCardExpenseID")), 0, adoRS("TimeCardExpenseID"))
m_TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
m_DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
m_ExpenseDate= IIF(IsNull(adoRS("ExpenseDate")), "12:00:00AM", adoRS("ExpenseDate"))
m_OldTimeCardExpenseID = m_TimeCardExpenseID
ReSetBrokenRule False
Else
Load = False
.Close
Exit Function
End If
.Close
End With
Load = True
IsDirty = False
IsNew = False
RaiseEvent OnRecordLoad(Me)
Exit Function
Err_Load:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCardExpense","Load")
End Function
'******************************************************************************
'* *
'* Name: LoadList *
'* *
'* Purpose: Load records based on a where SQL clause. *
'* You can include orderby clause in SQLWhereClause to sort data. *
'* *
'* Return: a TimeCardExpenses object *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As TimeCardExpenses
On Error GoTo Err_LoadList
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim uTimeCardExpense As TimeCardExpense
Dim uTimeCardExpenses As New TimeCardExpenses
strSQL = "Select a.ExpenseAmount,a.ExpenseCodeID,b.ExpenseCode As ExpenseCode,a.ExpenseDescription,a.ProjectID,c.ProjectName As ProjectName,a.TimeCardExpenseID,a.TimeCardID,d.DateEntered As DateEntered,a.ExpenseDate From (([Time Card Expenses] a LEFT JOIN [Expense Codes] b ON a.ExpenseCodeID = b.ExpenseCodeID) LEFT JOIN Projects c ON a.ProjectID = c.ProjectID) LEFT JOIN [Time Cards] d ON a.TimeCardID = d.TimeCardID" & SQLWhereClause
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
Do While Not .EOF
Set uTimeCardExpense = Nothing
Set uTimeCardExpense = New TimeCardExpense
uTimeCardExpense.ExpenseAmount= IIF(IsNull(adoRS("ExpenseAmount")), 0, adoRS("ExpenseAmount"))
uTimeCardExpense.ExpenseCodeID= IIF(IsNull(adoRS("ExpenseCodeID")), 0, adoRS("ExpenseCodeID"))
uTimeCardExpense.ExpenseCode= IIF(IsNull(adoRS("ExpenseCode")), "", adoRS("ExpenseCode"))
uTimeCardExpense.ExpenseDescription= IIF(IsNull(adoRS("ExpenseDescription")), "", adoRS("ExpenseDescription"))
uTimeCardExpense.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
uTimeCardExpense.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
uTimeCardExpense.TimeCardExpenseID= IIF(IsNull(adoRS("TimeCardExpenseID")), 0, adoRS("TimeCardExpenseID"))
uTimeCardExpense.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
uTimeCardExpense.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
uTimeCardExpense.ExpenseDate= IIF(IsNull(adoRS("ExpenseDate")), "12:00:00AM", adoRS("ExpenseDate"))
uTimeCardExpense.OldTimeCardExpenseID = uTimeCardExpense.TimeCardExpenseID
uTimeCardExpense.IsDirty = False
uTimeCardExpense.IsNew = False
uTimeCardExpense.ReSetBrokenRule False
uTimeCardExpenses.AddExisting uTimeCardExpense, ":" & uTimeCardExpense.TimeCardExpenseID
.MoveNext
Loop
.Close
End With
Set LoadList = uTimeCardExpenses
Exit Function
Err_LoadList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"TimeCardExpense","LoadList")
End Function
'******************************************************************************
'* *
'* Name: GetExpense CodesList() *
'* *
'* Purpose: Get the lookup table data into a string. *
'* This is useful for client app to fill combo box *
'* *
'* Returns: a string with Column delimeter vbTab and row delimeter "|" *
'* *
'******************************************************************************
Function GetExpenseCodesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select ExpenseCodeID,ExpenseCode from [Expense Codes]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetExpenseCodesList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetExpenseCodesList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: GetProjectsList() *
'* *
'* Purpose: Get the lookup table data into a string. *
'* This is useful for client app to fill combo box *
'* *
'* Returns: a string with Column delimeter vbTab and row delimeter "|" *
'* *
'******************************************************************************
Function GetProjectsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select ProjectID,ProjectName from [Projects]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetProjectsList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetProjectsList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: GetTime CardsList() *
'* *
'* Purpose: Get the lookup table data into a string. *
'* This is useful for client app to fill combo box *
'* *
'* Returns: a string with Column delimeter vbTab and row delimeter "|" *
'* *
'******************************************************************************
Function GetTimeCardsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select TimeCardID,DateEntered from [Time Cards]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetTimeCardsList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetTimeCardsList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: CopyMe *
'* *
'* Purpose: this method make another copy of this object in the memory *
'* *
'* Returns: Another TimeCardExpense. *
'* *
'******************************************************************************
Public Function CopyMe() As TimeCardExpense
Dim uTimeCardExpense As New TimeCardExpense
uTimeCardExpense.ExpenseAmount = m_ExpenseAmount
uTimeCardExpense.ExpenseCodeID = m_ExpenseCodeID
uTimeCardExpense.ExpenseCode = m_ExpenseCode
uTimeCardExpense.ExpenseDescription = m_ExpenseDescription
uTimeCardExpense.ProjectID = m_ProjectID
uTimeCardExpense.ProjectName = m_ProjectName
uTimeCardExpense.TimeCardExpenseID = m_TimeCardExpenseID
uTimeCardExpense.TimeCardID = m_TimeCardID
uTimeCardExpense.DateEntered = m_DateEntered
uTimeCardExpense.ExpenseDate = m_ExpenseDate
uTimeCardExpense.IsDirty = m_IsDirty
uTimeCardExpense.IsNew = m_IsNew
uTimeCardExpense.IsDeleted = m_IsDeleted
uTimeCardExpense.OldTimeCardExpenseID = m_OldTimeCardExpenseID
Set CopyMe = uTimeCardExpense
End Function
Private Function COMEXDataSourceSingle_GetData(ByVal Field As Long) As Variant
On Error Resume Next
If Field > 0 AND Field <= UBound(m_Fields) + 1 Then
COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1) & "IncludeLookup" , vbGet)
If err<>0 Then COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1), vbGet)
Else
COMEXDataSourceSingle_GetData = vbNullString
End If
End Function
Private Function COMEXDataSourceSingle_GetDataByName(ByVal FieldName As String) As Variant
On Error Resume Next
COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName & "IncludeLookup", vbGet)
If err<>0 Then COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName, vbGet)
End Function
Private Function COMEXDataSourceSingle_GetFieldCount() As Long
COMEXDataSourceSingle_GetFieldCount = UBound(m_Fields) + 1
End Function
Private Function COMEXDataSourceSingle_GetFieldName(ByVal Field As Long) As String
If Field > 0 AND Field <= UBound(m_Fields) + 1 Then
COMEXDataSourceSingle_GetFieldName = m_Fields(Field - 1)
Else
COMEXDataSourceSingle_GetFieldName = vbNullString
End If
End Function
Private Sub COMEXDataSourceSingle_SetData(ByVal Field As Long, ByVal newData As Variant)
If Field > 0 AND Field <= UBound(m_Fields) + 1 Then
Select Case m_Fields(Field-1)
Case "ExpenseAmount"
Me.ExpenseAmount = newData
Case "ExpenseCodeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ExpenseCodeIDIncludeLookup = newData
Case "ExpenseCode"
Me.ExpenseCode = newData
Case "ExpenseDescription"
Me.ExpenseDescription = newData
Case "ProjectID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ProjectIDIncludeLookup = newData
Case "ProjectName"
Me.ProjectName = newData
Case "TimeCardExpenseID"
Me.TimeCardExpenseID = newData
Case "TimeCardID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.TimeCardIDIncludeLookup = newData
Case "DateEntered"
Me.DateEntered = newData
Case "ExpenseDate"
Me.ExpenseDate = newData
End Select
End If
End Sub
Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)
Select Case FieldName
Case "ExpenseAmount"
Me.ExpenseAmount = newData
Case "ExpenseCodeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ExpenseCodeIDIncludeLookup = newData
Case "ExpenseCode"
Me.ExpenseCode = newData
Case "ExpenseDescription"
Me.ExpenseDescription = newData
Case "ProjectID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ProjectIDIncludeLookup = newData
Case "ProjectName"
Me.ProjectName = newData
Case "TimeCardExpenseID"
Me.TimeCardExpenseID = newData
Case "TimeCardID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.TimeCardIDIncludeLookup = newData
Case "DateEntered"
Me.DateEntered = newData
Case "ExpenseDate"
Me.ExpenseDate = newData
End Select
End Sub
Private Sub COMEXDataSourceSingle_Delete()
Call Delete
End Sub
Private Function COMEXDataSourceSingle_Save() As Boolean
COMEXDataSourceSingle_Save = Save
End Function
Private Function COMEXDataSourceSingle_CopyMe() As COMEXDataSourceSingle
Set COMEXDataSourceSingle_CopyMe = CopyMe
End Function
Private Property Get COMEXDataSourceSingle_IsDeleted() As Boolean
COMEXDataSourceSingle_IsDeleted = IsDeleted
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -