expdetailparam.cls

《VB6数据库开发指南》所有的例程的源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ExpDetailParam"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable(s) to hold property value(s)
Private mvarlngExpenseId As Long 'local copy
Private mvarstrEmployeeId As String 'local copy
Private mvarstrExpenseType As String 'local copy
Private mvarcurAmountSpent As Currency 'local copy
Private mvarstrDescription As String 'local copy
Private mvardtmDatePurchased As Date 'local copy
Private mvardtmDateSubmitted As Date 'local copy
Private mvarstrDbName As String 'local copy
Private mvarstrEmpToQuery As String 'local copy

Private mblnQueryOpen As Boolean

Private mobjAccess As New Access.Application
Private mobjRecSetExpense As Object

Public Property Let strEmpToQuery(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strEmpToQuery = 5
    mvarstrEmpToQuery = vData
    On Error GoTo OpenError
    
    If mblnQueryOpen Then
        mobjRecSetExpense.Close
    End If
    mobjAccess.DBEngine.Workspaces(0).Databases(0). _
                QueryDefs("ExpForOneEmployee").Parameters("EmpToFind"). _
                Value = mvarstrEmpToQuery
    Set mobjRecSetExpense = mobjAccess.DBEngine.Workspaces(0). _
                Databases(0).QueryDefs("ExpForOneEmployee"). _
                OpenRecordset()
    mblnQueryOpen = True
    
    Exit Property

OpenError:
    ' Since we are designing this class for potential unattended operation,
    ' we'll have to raise an error on our own
    Err.Raise Number:=Err.Number
    Err.Clear
    Exit Property
    
End Property


Public Property Get strEmpToQuery() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strEmpToQuery
    strEmpToQuery = mvarstrEmpToQuery
End Property



Private Sub ClearObject()
' Clears all object variables
    
    mvarlngExpenseId = 0
    mvarstrEmployeeId = ""
    mvarstrExpenseType = ""
    mvarcurAmountSpent = 0
    mvarstrDescription = ""
    mvardtmDatePurchased = CDate("1/1/1980")
    mvardtmDateSubmitted = CDate("1/1/1980")
    mvarstrEmpToQuery = ""
    
End Sub

Public Property Let strDbName(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strDbName = 5
    
    On Error GoTo OpenError
    
    If mblnQueryOpen Then
        mobjAccess.CloseCurrentDatabase
    End If
    mvarstrDbName = vData
    mobjAccess.OpenCurrentDatabase mvarstrDbName
    mobjAccess.Application.Visible = False
    mobjAccess.DBEngine.Workspaces(0).Databases(0). _
                QueryDefs("ExpForOneEmployee").Parameters("EmpToFind"). _
                Value = mvarstrEmpToQuery
    Set mobjRecSetExpense = mobjAccess.DBEngine.Workspaces(0). _
                Databases(0).QueryDefs("ExpForOneEmployee"). _
                OpenRecordset()
    
    mblnQueryOpen = True
    
    Exit Property

OpenError:
    ' Since we are designing this class for potential unattended operation,
    ' we'll have to raise an error on our own
    Err.Raise Number:=Err.Number
    Err.Clear
    Exit Property
    
End Property

Public Property Get strDbName() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strDbName
    strDbName = mvarstrDbName
End Property
Public Function MoveNext() As String
' Moves to next Expenses table record and sets current object values

    On Error GoTo MoveError
    
    With mobjRecSetExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveNext = "EOF"
        Else
            ' Move to the next record
            .MoveNext
            If mobjRecSetExpense.EOF Then
                MoveNext = "EOF"
            Else
                Call GetRecordset(mobjRecSetExpense)
                MoveNext = "OK"
            End If
        End If
    End With
    
    Exit Function
    
MoveError:
    ' Return the error description
    MoveNext = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MovePrev() As String
' Retrieve the record prior to the current one

    On Error GoTo MoveError
    
    With mobjRecSetExpense
    
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MovePrev = "BOF"
        Else
            ' Move to the previous record
            .MovePrevious
            If .BOF Then
                MovePrev = "BOF"
            Else
                Call GetRecordset(mobjRecSetExpense)
                MovePrev = "OK"
            End If
        End If
        
    
    End With
    
    Exit Function
    
MoveError:
    ' Return the error description
    MovePrev = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MoveLast() As String
' Retrieve the last record

    On Error GoTo MoveError
    
    With mobjRecSetExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveLast = "EOF"
        Else
            ' Move to the last record
            .MoveLast
            Call GetRecordset(mobjRecSetExpense)
            MoveLast = "OK"
        End If
    End With
    
    Exit Function

MoveError:
    ' Return the error description
    MoveLast = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MoveFirst() As String
' Retrieve the first record

    On Error GoTo MoveError
    With mobjRecSetExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveFirst = "BOF"
        Else
            ' Move to the first record
            .MoveFirst
            Call GetRecordset(mobjRecSetExpense)
            MoveFirst = "OK"
        End If
    End With
    
    Exit Function

MoveError:
    ' Return the error description
    MoveFirst = Err.Description
    Err.Clear
    Exit Function
End Function

Public Property Get dtmDateSubmitted() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.dtmDateSubmitted
    dtmDateSubmitted = mvardtmDateSubmitted
End Property

Public Property Let dtmDatePurchased(ByVal vData As Date)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.dtmDatePurchased = 5
    mvardtmDatePurchased = vData
End Property

Public Property Get dtmDatePurchased() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.dtmDatePurchased
    dtmDatePurchased = mvardtmDatePurchased
End Property

Public Property Let strDescription(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strDescription = 5
    mvarstrDescription = vData
End Property

Public Property Get strDescription() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strDescription
    strDescription = mvarstrDescription
End Property

Public Property Let curAmountSpent(ByVal vData As Currency)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.curAmountSpent = 5
    mvarcurAmountSpent = vData
End Property

Public Property Get curAmountSpent() As Currency
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.curAmountSpent
    curAmountSpent = mvarcurAmountSpent
End Property

Public Function strSetExpenseType(ByVal vData As String) As String
' Sets the expense type to an allowed value
    Dim strTemp As String
    strTemp = UCase$(vData)
    
    If strTemp = "TRAVEL" _
    Or strTemp = "MEALS" _
    Or strTemp = "OFFICE" _
    Or strTemp = "AUTO" _
    Or strTemp = "TOLL/PARK" Then
        mvarstrExpenseType = strTemp
        strSetExpenseType = "OK"
    Else
        strSetExpenseType = "Expense type must be TRAVEL, MEALS, " _
                            & "OFFICE, AUTO, or TOLL/PARK"
    End If
    
End Function
Public Property Get strExpenseType() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strExpenseType
    strExpenseType = mvarstrExpenseType
End Property

Public Property Let strEmployeeId(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strEmployeeId = 5
    mvarstrEmployeeId = vData
End Property

Public Property Get strEmployeeId() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strEmployeeId
    strEmployeeId = mvarstrEmployeeId
End Property

Public Property Get lngExpenseId() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.lngExpenseId
    lngExpenseId = mvarlngExpenseId
End Property

Private Sub Class_Initialize()
    
    ' Indicate the the database is not yet open
    mblnQueryOpen = False
    ' Clear all object variables
    Call ClearObject
    
End Sub

Private Sub Class_Terminate()

    ' Close the recordset
    mobjRecSetExpense.Close
    mobjAccess.CloseCurrentDatabase
    mobjAccess.Quit
    
End Sub
Private Sub GetRecordset(recExp As Recordset)
' Copies current values to Recordset

    With recExp
        mvarlngExpenseId = 0 + !ExpenseID
        mvarstrEmployeeId = "" & !Expr1
        mvarstrExpenseType = "" & !ExpenseType
        mvarcurAmountSpent = 0 + !AmountSpent
        mvarstrDescription = "" & !Description
        mvardtmDatePurchased = !DatePurchased
        mvardtmDateSubmitted = !DateSubmitted
    End With
    
End Sub