?? projtimecardhour.cls
字號:
'* *
'* Name: DeleteList *
'* *
'* 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 Hours] " & strDeleteSQL
Conn.Execute strSQL
DeleteList = True
Exit Function
Err_DeleteList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ProjTimeCardHour","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 vTimeCardDetailID As Long) As Boolean
On Error GoTo Err_Load
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Clear
strSQL = "Select a.BillableHours,a.BillingRate,a.ProjectID,b.ProjectName As ProjectName,a.TimeCardDetailID,a.TimeCardID,c.DateEntered As DateEntered,a.WorkCodeID,d.WorkCode As WorkCode,a.WorkDescription,a.DateWorked From (([Time Card Hours] a LEFT JOIN Projects b ON a.ProjectID = b.ProjectID) LEFT JOIN [Time Cards] c ON a.TimeCardID = c.TimeCardID) LEFT JOIN [Work Codes] d ON a.WorkCodeID = d.WorkCodeID WHERE a.TimeCardDetailID=" & vTimeCardDetailID & ""
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
If Not .EOF Then
m_BillableHours= IIF(IsNull(adoRS("BillableHours")), 0, adoRS("BillableHours"))
m_BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
m_TimeCardDetailID= IIF(IsNull(adoRS("TimeCardDetailID")), 0, adoRS("TimeCardDetailID"))
m_TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
m_DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
m_WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
m_WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
m_WorkDescription= IIF(IsNull(adoRS("WorkDescription")), "", adoRS("WorkDescription"))
m_DateWorked= IIF(IsNull(adoRS("DateWorked")), "12:00:00AM", adoRS("DateWorked"))
m_OldTimeCardDetailID = m_TimeCardDetailID
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,"ProjTimeCardHour","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 ProjTimeCardHours object *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As ProjTimeCardHours
On Error GoTo Err_LoadList
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim uProjTimeCardHour As ProjTimeCardHour
Dim uProjTimeCardHours As New ProjTimeCardHours
strSQL = "Select a.BillableHours,a.BillingRate,a.ProjectID,b.ProjectName As ProjectName,a.TimeCardDetailID,a.TimeCardID,c.DateEntered As DateEntered,a.WorkCodeID,d.WorkCode As WorkCode,a.WorkDescription,a.DateWorked From (([Time Card Hours] a LEFT JOIN Projects b ON a.ProjectID = b.ProjectID) LEFT JOIN [Time Cards] c ON a.TimeCardID = c.TimeCardID) LEFT JOIN [Work Codes] d ON a.WorkCodeID = d.WorkCodeID" & SQLWhereClause
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
Do While Not .EOF
Set uProjTimeCardHour = Nothing
Set uProjTimeCardHour = New ProjTimeCardHour
uProjTimeCardHour.BillableHours= IIF(IsNull(adoRS("BillableHours")), 0, adoRS("BillableHours"))
uProjTimeCardHour.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
uProjTimeCardHour.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
uProjTimeCardHour.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
uProjTimeCardHour.TimeCardDetailID= IIF(IsNull(adoRS("TimeCardDetailID")), 0, adoRS("TimeCardDetailID"))
uProjTimeCardHour.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
uProjTimeCardHour.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
uProjTimeCardHour.WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
uProjTimeCardHour.WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
uProjTimeCardHour.WorkDescription= IIF(IsNull(adoRS("WorkDescription")), "", adoRS("WorkDescription"))
uProjTimeCardHour.DateWorked= IIF(IsNull(adoRS("DateWorked")), "12:00:00AM", adoRS("DateWorked"))
uProjTimeCardHour.OldTimeCardDetailID = uProjTimeCardHour.TimeCardDetailID
uProjTimeCardHour.IsDirty = False
uProjTimeCardHour.IsNew = False
uProjTimeCardHour.ReSetBrokenRule False
uProjTimeCardHours.AddExisting uProjTimeCardHour, ":" & uProjTimeCardHour.TimeCardDetailID
.MoveNext
Loop
.Close
End With
Set LoadList = uProjTimeCardHours
Exit Function
Err_LoadList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ProjTimeCardHour","LoadList")
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: GetWork 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 GetWorkCodesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select WorkCodeID,WorkCode from [Work Codes]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetWorkCodesList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetWorkCodesList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: CopyMe *
'* *
'* Purpose: this method make another copy of this object in the memory *
'* *
'* Returns: Another ProjTimeCardHour. *
'* *
'******************************************************************************
Public Function CopyMe() As ProjTimeCardHour
Dim uProjTimeCardHour As New ProjTimeCardHour
uProjTimeCardHour.BillableHours = m_BillableHours
uProjTimeCardHour.BillingRate = m_BillingRate
uProjTimeCardHour.ProjectID = m_ProjectID
uProjTimeCardHour.ProjectName = m_ProjectName
uProjTimeCardHour.TimeCardDetailID = m_TimeCardDetailID
uProjTimeCardHour.TimeCardID = m_TimeCardID
uProjTimeCardHour.DateEntered = m_DateEntered
uProjTimeCardHour.WorkCodeID = m_WorkCodeID
uProjTimeCardHour.WorkCode = m_WorkCode
uProjTimeCardHour.WorkDescription = m_WorkDescription
uProjTimeCardHour.DateWorked = m_DateWorked
uProjTimeCardHour.IsDirty = m_IsDirty
uProjTimeCardHour.IsNew = m_IsNew
uProjTimeCardHour.IsDeleted = m_IsDeleted
uProjTimeCardHour.OldTimeCardDetailID = m_OldTimeCardDetailID
Set CopyMe = uProjTimeCardHour
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 "BillableHours"
Me.BillableHours = newData
Case "BillingRate"
Me.BillingRate = 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 "TimeCardDetailID"
Me.TimeCardDetailID = 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 "WorkCodeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.WorkCodeIDIncludeLookup = newData
Case "WorkCode"
Me.WorkCode = newData
Case "WorkDescription"
Me.WorkDescription = newData
Case "DateWorked"
Me.DateWorked = newData
End Select
End If
End Sub
Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)
Select Case FieldName
Case "BillableHours"
Me.BillableHours = newData
Case "BillingRate"
Me.BillingRate = 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 "TimeCardDetailID"
Me.TimeCardDetailID = 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 "WorkCodeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.WorkCodeIDIncludeLookup = newData
Case "WorkCode"
Me.WorkCode = newData
Case "WorkDescription"
Me.WorkDescription = newData
Case "DateWorked"
Me.DateWorked = 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 + -