?? expensedetail.cls
字號:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ExpenseDetail"
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
' Database variables needed to keep track of current
' database condition
Private mdbExpense As Database
Private mrecExpense As Recordset
Private mblnRecSetOpen As Boolean
Private Sub ClearObject()
' Clears all object variables
mvarlngExpenseId = 0
mvarstrEmployeeId = ""
mvarstrExpenseType = ""
mvarcurAmountSpent = 0
mvarstrDescription = ""
mvardtmDatePurchased = CDate("1/1/1980")
mvardtmDateSubmitted = CDate("1/1/1980")
End Sub
Public Function Delete() As String
' Deletes the expense detail record whose value is current from the
' database
On Error GoTo DeleteError
With mrecExpense
.Delete
If 0 = .RecordCount Then
Call ClearObject
Else
.MoveNext
If .EOF Then
Call ClearObject
Else
Call GetRecordset(mrecExpense)
End If
End If
End With
Delete = "OK"
Exit Function
DeleteError:
' Return the error description
Delete = Err.Description
Err.Clear
Exit Function
End Function
Public Function Insert() As String
' Inserts a brand new record into the database and leaves the newly
' inserted values as the current object values.
On Error GoTo InsertError
With mrecExpense
.AddNew
mvardtmDateSubmitted = Now
Call SetRecordset(mrecExpense)
.Update
'Move to the most recently modified record
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
End With
Insert = "OK"
Exit Function
InsertError:
' Return the error description
Insert = Err.Description
Err.Clear
Exit Function
End Function
Public Function Update() As String
' Updates Expenses table from current object values
Dim strSql As String
On Error GoTo UpdateError
With mrecExpense
.Edit
Call SetRecordset(mrecExpense)
.Update
.Bookmark = .LastModified
Call GetRecordset(mrecExpense)
End With
Update = "OK"
Exit Function
UpdateError:
' Return the error description
Update = Err.Description
Err.Clear
Exit Function
End Function
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 mblnRecSetOpen Then
mrecExpense.Close
mdbExpense.Close
End If
mvarstrDbName = vData
Set mdbExpense = DBEngine.Workspaces(0).OpenDatabase(mvarstrDbName)
Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
mblnRecSetOpen = 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 mrecExpense
If True = .BOF _
And True = .EOF Then
' Empty recordset
MoveNext = "EOF"
Else
' Move to the next record
.MoveNext
If mrecExpense.EOF Then
MoveNext = "EOF"
Else
Call GetRecordset(mrecExpense)
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 mrecExpense
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(mrecExpense)
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 mrecExpense
If True = .BOF _
And True = .EOF Then
' Empty recordset
MoveLast = "EOF"
Else
' Move to the last record
.MoveLast
Call GetRecordset(mrecExpense)
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 mrecExpense
If True = .BOF _
And True = .EOF Then
' Empty recordset
MoveFirst = "BOF"
Else
' Move to the first record
.MoveFirst
Call GetRecordset(mrecExpense)
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
mblnRecSetOpen = False
' Clear all object variables
Call ClearObject
End Sub
Private Sub Class_Terminate()
' We don't really care about errors when cleaning up.
On Error Resume Next
' Close the recordset
mrecExpense.Close
' Close the expense database
mdbExpense.Close
' Reset the error handler
On Error GoTo 0
Exit Sub
End Sub
Private Sub SetRecordset(recExp As Recordset)
' Copies current values to Recordset
With recExp
!EmployeeId = mvarstrEmployeeId
!ExpenseType = mvarstrExpenseType
!AmountSpent = mvarcurAmountSpent
!Description = mvarstrDescription
!DatePurchased = mvardtmDatePurchased
!DateSubmitted = mvardtmDateSubmitted
End With
End Sub
Private Sub GetRecordset(recExp As Recordset)
' Copies current values to Recordset
With recExp
mvarlngExpenseId = 0 + !ExpenseID
mvarstrEmployeeId = "" & !EmployeeId
mvarstrExpenseType = "" & !ExpenseType
mvarcurAmountSpent = 0 + !AmountSpent
mvarstrDescription = "" & !Description
mvardtmDatePurchased = !DatePurchased
mvardtmDateSubmitted = !DateSubmitted
End With
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -