?? clientproject.cls
字號:
.MoveNext
Loop
.Close
End With
Set LoadList = uClientProjects
Exit Function
Err_LoadList:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ClientProject","LoadList")
End Function
'******************************************************************************
'* *
'* Name: LoadByEmployeeID *
'* *
'* Purpose: Load records based on EmployeeID *
'* Optionally you can include orderby clause to sort data. *
'* *
'* Return: a ClientProjects object *
'******************************************************************************
Function LoadByEmployeeID(ByVal vEmployeeID As Long , Optional ByVal OrderByClause As String = vbNullString , Optional GetChildren As Boolean = False) As ClientProjects
On Error GoTo Err_LoadByEmployeeID
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim uClientProject As ClientProject
Dim uClientProjects As New ClientProjects
strSQL = "Select a.ClientID,b.CompanyName As CompanyName,a.EmployeeID,c.FirstName As FirstName,c.LastName As LastName,a.ProjectDescription,a.ProjectEndDate,a.ProjectID,a.ProjectName,a.ProjectTotalBillingEstimate,a.PurchaseOrderNumber,a.ProjectBeginDate From (Projects a LEFT JOIN Clients b ON a.ClientID = b.ClientID) LEFT JOIN Employees c ON a.EmployeeID = c.EmployeeID Where a.EmployeeID = " & vEmployeeID & "" & OrderByClause
adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
With adoRS
Do While Not .EOF
Set uClientProject = Nothing
Set uClientProject = New ClientProject
uClientProject.ClientID= IIF(IsNull(adoRS("ClientID")), 0, adoRS("ClientID"))
uClientProject.CompanyName= IIF(IsNull(adoRS("CompanyName")), "", adoRS("CompanyName"))
uClientProject.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
uClientProject.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
uClientProject.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
uClientProject.ProjectDescription= IIF(IsNull(adoRS("ProjectDescription")), "", adoRS("ProjectDescription"))
uClientProject.ProjectEndDate = adoRS("ProjectEndDate")
uClientProject.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
uClientProject.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
uClientProject.ProjectTotalBillingEstimate= IIF(IsNull(adoRS("ProjectTotalBillingEstimate")), 0, adoRS("ProjectTotalBillingEstimate"))
uClientProject.PurchaseOrderNumber= IIF(IsNull(adoRS("PurchaseOrderNumber")), "", adoRS("PurchaseOrderNumber"))
uClientProject.ProjectBeginDate= IIF(IsNull(adoRS("ProjectBeginDate")), "12:00:00AM", adoRS("ProjectBeginDate"))
uClientProject.OldProjectID = uClientProject.ProjectID
uClientProject.IsDirty = False
uClientProject.IsNew = False
uClientProject.ReSetBrokenRule False
uClientProjects.AddExisting uClientProject, ":" & uClientProject.ProjectID
If GetChildren Then uClientProject.ProjTimeCardHours.LoadRelated uClientProject.ProjectID
If GetChildren Then uClientProject.ProjTimeCardExpenses.LoadRelated uClientProject.ProjectID
If GetChildren Then uClientProject.Payments.LoadRelated uClientProject.ProjectID
.MoveNext
Loop
.Close
End With
Set LoadByEmployeeID = uClientProjects
Exit Function
Err_LoadByEmployeeID:
ErrNum = Err.Number
ErrMsg = Err.Description
Call ErrHandler(ErrNum, ErrMsg,"ClientProject","LoadByEmployeeID")
End Function
'******************************************************************************
'* *
'* Name: GetClientsList() *
'* *
'* 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 GetClientsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select ClientID,CompanyName from [Clients]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetClientsList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetClientsList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: GetEmployeesList() *
'* *
'* 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 GetEmployeesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
Dim adoRs As New ADODB.Recordset
Dim strSQL As string
strSQL = "Select EmployeeID,FirstName,LastName from [Employees]"
With adoRs
.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
If Not .EOF Then
GetEmployeesList = _
adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
Else
GetEmployeesList = vbNullString
End If
.Close
End With
End Function
'******************************************************************************
'* *
'* Name: CopyMe *
'* *
'* Purpose: this method make another copy of this object in the memory *
'* *
'* Returns: Another ClientProject. *
'* *
'******************************************************************************
Public Function CopyMe() As ClientProject
Dim uClientProject As New ClientProject
uClientProject.ClientID = m_ClientID
uClientProject.CompanyName = m_CompanyName
uClientProject.EmployeeID = m_EmployeeID
uClientProject.FirstName = m_FirstName
uClientProject.LastName = m_LastName
uClientProject.ProjectDescription = m_ProjectDescription
uClientProject.ProjectEndDate = m_ProjectEndDate
uClientProject.ProjectID = m_ProjectID
uClientProject.ProjectName = m_ProjectName
uClientProject.ProjectTotalBillingEstimate = m_ProjectTotalBillingEstimate
uClientProject.PurchaseOrderNumber = m_PurchaseOrderNumber
uClientProject.ProjectBeginDate = m_ProjectBeginDate
uClientProject.IsDirty = m_IsDirty
uClientProject.IsNew = m_IsNew
uClientProject.IsDeleted = m_IsDeleted
uClientProject.OldProjectID = m_OldProjectID
Dim uProjTimeCardHour As ProjTimeCardHour
Dim oProjTimeCardHour As ProjTimeCardHour
For Each oProjTimeCardHour In m_ProjTimeCardHours
Set uProjTimeCardHour = Nothing
Set uProjTimeCardHour = New ProjTimeCardHour
Set uProjTimeCardHour = oProjTimeCardHour.CopyMe
uClientProject.ProjTimeCardHours.AddExisting uProjTimeCardHour, m_ProjTimeCardHours.Key(oProjTimeCardHour)
Next
Dim uProjTimeCardExpense As ProjTimeCardExpense
Dim oProjTimeCardExpense As ProjTimeCardExpense
For Each oProjTimeCardExpense In m_ProjTimeCardExpenses
Set uProjTimeCardExpense = Nothing
Set uProjTimeCardExpense = New ProjTimeCardExpense
Set uProjTimeCardExpense = oProjTimeCardExpense.CopyMe
uClientProject.ProjTimeCardExpenses.AddExisting uProjTimeCardExpense, m_ProjTimeCardExpenses.Key(oProjTimeCardExpense)
Next
Dim uPayment As Payment
Dim oPayment As Payment
For Each oPayment In m_Payments
Set uPayment = Nothing
Set uPayment = New Payment
Set uPayment = oPayment.CopyMe
uClientProject.Payments.AddExisting uPayment, m_Payments.Key(oPayment)
Next
Set CopyMe = uClientProject
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 "ClientID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ClientIDIncludeLookup = newData
Case "CompanyName"
Me.CompanyName = newData
Case "EmployeeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.EmployeeIDIncludeLookup = newData
Case "FirstName"
Me.FirstName = newData
Case "LastName"
Me.LastName = newData
Case "ProjectDescription"
Me.ProjectDescription = newData
Case "ProjectEndDate"
Me.ProjectEndDate = newData
Case "ProjectID"
Me.ProjectID = newData
Case "ProjectName"
Me.ProjectName = newData
Case "ProjectTotalBillingEstimate"
Me.ProjectTotalBillingEstimate = newData
Case "PurchaseOrderNumber"
Me.PurchaseOrderNumber = newData
Case "ProjectBeginDate"
Me.ProjectBeginDate = newData
End Select
End If
End Sub
Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)
Select Case FieldName
Case "ClientID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.ClientIDIncludeLookup = newData
Case "CompanyName"
Me.CompanyName = newData
Case "EmployeeID"
'Why? ComboBox returns a string with all subprop information, we need to parse it
'and update all properties
Me.EmployeeIDIncludeLookup = newData
Case "FirstName"
Me.FirstName = newData
Case "LastName"
Me.LastName = newData
Case "ProjectDescription"
Me.ProjectDescription = newData
Case "ProjectEndDate"
Me.ProjectEndDate = newData
Case "ProjectID"
Me.ProjectID = newData
Case "ProjectName"
Me.ProjectName = newData
Case "ProjectTotalBillingEstimate"
Me.ProjectTotalBillingEstimate = newData
Case "PurchaseOrderNumber"
Me.PurchaseOrderNumber = newData
Case "ProjectBeginDate"
Me.ProjectBeginDate = 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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -