⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 timecardexpense.cls

📁 人事档案管理系统(PB)/人事工资管理系统/干部信息管理系统/投标报价与合同管理系统/... 超市...
💻 CLS
📖 第 1 页 / 共 2 页
字号:
'* 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 + -