?? crecord.cls
字號:
Resume ErrOut
End If
ExitEntry:
Move = True
mstrErrDescription = ""
mlngErrNo = 0
Exit Function
ErrOut:
Move = False
mlngErrNo = -1
mstrErrDescription = "目前記錄為空,無法移動!"
Exit Function
OutSpace:
Move = False
mlngErrNo = -1
mstrErrDescription = "移動越界。"
Exit Function
E:
Move = False
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Function
'******************************************************************************
'目的:移動到最后一條記錄
'輸入:
'返回:成功/失敗
'******************************************************************************
Public Function MoveLast()
On Error GoTo E
If Not IsArray(mvarData) Then Resume ErrOut
If UBound(mvarData) >= 0 Then
mCurPosition = UBound(mvarData)
Else
Resume ErrOut
End If
ExitEntry:
MoveLast = True
mstrErrDescription = ""
mlngErrNo = 0
Exit Function
ErrOut:
mlngErrNo = -1
mstrErrDescription = "目前記錄為空,無法移動!"
Exit Function
E:
MoveLast = False
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Function
'******************************************************************************
'目的:根據FieldName找對應Item
'輸入:FeildName
'返回:Item
'******************************************************************************
Private Function Name2Item(ByVal sName As String) As Long
On Error GoTo ErrH
Dim i As Long
Name2Item = -1
If Not IsArray(mstrField) Then
Exit Function
Else
For i = 0 To UBound(mstrField)
If UCase(sName) = UCase(mstrField(i)) Then
Name2Item = i
Exit Function
End If
Next i
End If
Exit Function
ErrH:
End Function
'******************************************************************************
'目的: 根據Item找FieldName
'輸入: Item
'返回: FieldName
'******************************************************************************
Private Function Item2Name(ByVal Item As Long) As String
On Error Resume Next
Item2Name = ""
If Not IsArray(mstrField) Then
Exit Function
ElseIf UBound(mstrField) <= Item Then
Item2Name = mstrField(Item)
Exit Function
End If
End Function
'******************************************************************************
'目的: 檢查輸入的FieldName是否合法
'輸入: FieldName
'返回: True/False
'******************************************************************************
Private Function CheckField(ByVal sName As String) As Boolean
On Error GoTo ErrH
Dim i As Long
CheckField = False
If Not IsArray(mstrField) Then
Exit Function
End If
For i = 0 To UBound(mstrField)
If UCase(mstrField(i)) = UCase(sName) Then
CheckField = True
Exit Function
End If
Next i
Exit Function
ErrH:
End Function
Public Property Let TableName(ByVal sTableName As String)
mstrTableName = sTableName
End Property
Public Property Get TableName() As String
TableName = mstrTableName
End Property
Public Function AddKeyField(ByVal Field As Variant) As Boolean
On Error GoTo E
Dim i As Integer, varTemp As Variant
Dim sFieldName As String, lngItem As Long
If Not IsArray(mstrField) Then
mlngErrNo = -1
mstrErrDescription = "請先使用AddField添加兩個或兩個以上字段。"
Exit Function
End If
If Not IsNumeric(Field) Then
If CheckField(Field) Then
sFieldName = Field
End If
Else
sFieldName = Item2Name(Val(Field))
End If
If sFieldName <> "" Then
If IsArray(mstrKeyField) Then
ReDim Preserve mstrKeyField(UBound(mstrKeyField) + 1) As Variant
mstrKeyField(UBound(mstrKeyField)) = sFieldName
Else
ReDim mstrKeyField(0) As Variant
mstrKeyField(0) = sFieldName
End If
Else
Resume InvalidField
End If
ExitEntry:
AddKeyField = True
mstrErrDescription = ""
mlngErrNo = 0
Exit Function
InvalidField:
AddKeyField = False
mstrErrDescription = "無效的字段。"
mlngErrNo = -1
Exit Function
E:
AddKeyField = False
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Function
Public Function Save() As Boolean
On Error Resume Next
Dim strSearch As String
If Not IsArray(mstrField) Then Resume NoField
If Not IsArray(mvarData) Then Resume NoData
If UBound(mstrField) < 1 Then Resume NoField
On Error GoTo E
Dim i As Integer, strValue As String, strSql As String
Dim adoRst As New ADODB.Recordset, j As Integer
'先整理KEY
If Not IsArray(mstrKeyField) Then
ReDim mstrKeyField(0) As Variant
mstrKeyField(0) = mstrField(0)
End If
For i = 0 To UBound(mstrField)
strValue = strValue & "," & mstrField(i)
Next i
If Len(Trim(strValue)) > 1 Then
strValue = Right(strValue, Len(strValue) - 1)
strSql = "Select " & strValue & " From " & mstrTableName & " "
'不可以沒有被選取的字段
Else
Exit Function
End If
adoRst.CursorLocation = adUseClient
With adoRst
'根據varData逐條記錄更新表
For i = 0 To UBound(mvarData)
Select Case mvarData(i)(mstrKeyField(0))
'表示新增記錄
Case 0
.Open strSql & " Where 1=0", mAdoConn, adOpenDynamic, adLockOptimistic
.AddNew
On Error Resume Next
For j = 0 To adoRst.Fields.Count - 1
.Fields(j).Value = mvarData(i)(mstrField(j))
Next j
On Error GoTo E
.Update
.Close
'表示刪除記錄
Case -1
strSearch = ""
For j = 0 To UBound(mstrKeyField)
If strSearch = "" Then
strSearch = mstrField(j) & "=" & mvarData(i)(mstrField(j))
Else
strSearch = strSearch & " And " & mstrField(j) & "=" & mvarData(i)(mstrField(j))
End If
Next j
mAdoConn.Execute "Delete From " & mstrTableName & " Where " & strSearch
'表示更新記錄
Case Else
strSearch = ""
For j = 0 To UBound(mstrKeyField)
If strSearch = "" Then
strSearch = mstrField(j) & "=" & mvarData(i)(mstrField(j))
Else
strSearch = strSearch & " And " & mstrField(j) & "=" & mvarData(i)(mstrField(j))
End If
Next j
.Open strSql & " Where " & strSearch, mAdoConn, adOpenDynamic, adLockOptimistic
If Not .EOF Then
On Error Resume Next
For j = 0 To adoRst.Fields.Count - 1
.Fields(j).Value = mvarData(i)(mstrField(j))
Next j
On Error GoTo E
.Update
End If
.Close
End Select
Next i
End With
ExitEntry:
Save = True
mlngErrNo = 0
mstrErrDescription = ""
Exit Function
NoField:
Save = False
mlngErrNo = -1
mstrErrDescription = "字段集合未定義或數目不夠。"
Exit Function
NoData:
Save = False
mlngErrNo = -1
mstrErrDescription = "沒有數據,無需保存。"
Exit Function
E:
Save = False
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Function
Public Sub Init()
On Error Resume Next
Dim var As Variant
mstrField = var
mbIsDataAdded = False
mCurPosition = -1
mvarData = var
mstrTableName = ""
mstrKeyField = var
mlngErrNo = 0
mstrErrDescription = ""
If Not mAdoConn Is Nothing Then
Set mAdoConn = Nothing
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -