|
摘 要：本文介绍了“Access数据库数值记录批量修改系统”的程序设计方法，并给出了程序代码及说明。
关键词：数据库 数据表 数值型 字段 公式 VB Access 事件代码
一、前言
Microsoft Access具有查找、替换、排序及简单的数据单元编辑功能，可以说其数据编辑功能是非常有限的。通常，为了高效地编辑Access数据库，人们常用的方法是应用宏或导出到Microsoft Excel中进行编辑。但编辑的宏其适用的数据库范围很有限，即需要不断的修改宏以适应不同的数据库，而经Excel编辑后的数据却又无法导入到Access中，因为Access没有导入功能。鉴于上述原因，本人设计了“Access数据库数值记录批量修改系统”。
二、软件设计
1、窗体与控件
本系统在VB6+Spk3+Win98+Offices2000环境下调试通过。根据功能要求，程序运行窗体如图所示。其上主要有如下控件：Drive1（磁盘列表）、Dir1（目录列表）、File1（文件列表）、Combo1（文件类型列表）、Combo2（数据表列表）、Combo3（需要修改的数值型字段列表）、Combo4（数值型字段列表）、List1（字段信息列表）、Option1及Option2（范围方式）、Text1及Text2（修改公式之系数a及系数b）、Text3及Text4（修改范围之起止记录号）、Data1（数据库控件）、MSFlexGrid1（Access数据记录表，用于显示记录信息，数据源关联到Data1）。
2、变量申明
在工程\引用中将Microsoft DAO3.6 Object Library项打钩，在工程\部件中将Microsoft FlexGrid Control 6.0及Microsoft Windows Common Controls-2 6.0两项打钩，并在模块首部加上如下申明：
Dim FileName As String '库文件名
Dim File_db As Database '数据库
3、程序代码及说明
Private Sub Combo2_Click() '在表列表中选择一个表
Dim WsInfo As String '字段类型
On Error GoTo ErrDo
If Trim(Combo2) = "" Then Exit Sub
List1.Clear '清空字段列表框
Combo3.Clear
Combo4.Clear
Set DBTable = File_db.OpenRecordset(Combo2) '打开选择的表
Ws_Num = DBTable.Fields.Count '获取表中的字段数
For i = 0 To Ws_Num - 1
Select Case DBTable.Fields(i).Type '字段类型
Case 1
WsInfo = "逻辑型"
Case 2
WsInfo = "字节型"
Case 3
WsInfo = "整型"
Case 4
WsInfo = "长整型"
Case 5
WsInfo = "货币"
Case 6
WsInfo = "单精度型"
Case 7
WsInfo = "双精度型"
Case 8
WsInfo = "日期型"
Case 10
WsInfo = "字符型"
Case 11
WsInfo = "OLE 对象"
Case 12
WsInfo = "备注型"
Case 15
WsInfo = "同步复制 ID"
End Select
If WsInfo = "字节型" Or WsInfo = "整型" Or WsInfo = "长整型" Or WsInfo = "货币" Or WsInfo = "单精度型" Or WsInfo = "双精度型" Then
Combo3.AddItem DBTable.Fields(i).Name'向Combo3添加表中数值型字段
Combo4.AddItem DBTable.Fields(i).Name'向Combo4添加表中数值型字段
Combo3 = DBTable.Fields(i).Name
Combo4 = DBTable.Fields(i).Name
End If
List1.AddItem DBTable.Fields(i).Name + " 【" + WsInfo + "：" + CStr(DBTable.Fields(i).Size) + "】" '向字段列表框添加表中的所有字段
Next
Data1.DatabaseName = FileName '关联数据库
Data1.RecordSource = File_db.TableDefs(Combo2).Name '关联数据表
Data1.Refresh
MSFlexGrid1.TextMatrix(0, 0) = "记录号" '增加固定列(记录号)，以便根据记录号指定修改范围
For i = 1 To Data1.Recordset.RecordCount
MSFlexGrid1.TextMatrix(i, 0) = i '增加记录号
Next
For i = 0 To Data1.Recordset.Fields.Count '所有列居中对齐
MSFlexGrid1.ColAlignment(i) = 3
Next
Frame5.Caption = "修改范围（记录数：" + CStr(Data1.Recordset.RecordCount) + "）"
UpDown1.Max = Data1.Recordset.RecordCount
UpDown2.Max = Data1.Recordset.RecordCount
UpDown2.Value = Data1.Recordset.RecordCount
If Data1.Recordset.Fields.Count = 0 Then
UpDown1.Min = 0
UpDown1.Value = 0
UpDown2.Min = 0
Text3.ToolTipText = "数据范围：0～" + CStr(Data1.Recordset.RecordCount)
Text4.ToolTipText = "数据范围：0～" + CStr(Data1.Recordset.RecordCount)
Else
UpDown1.Min = 1
UpDown1.Value = 1
UpDown2.Min = 1
Text3.ToolTipText = "数据范围：1～" + CStr(Data1.Recordset.RecordCount)
Text4.ToolTipText = "数据范围：1～" + CStr(Data1.Recordset.RecordCount)
End If
Exit Sub
ErrDo:
MsgBox Error(Err), vbCritical, "数据表选择"
Resume Next
End Sub
Private Sub Combo3_Change()
Combo4.Text = Combo3.Text
End Sub
Private Sub Combo3_Click()
Combo4.Text = Combo3.Text
End Sub
Private Sub Command2_Click() '修改数据
On Error GoTo ErrDo
Dim Formula As String '修改公式
Set DBTable = File_db.OpenRecordset(Combo2) '打开选择的表
If Combo3.ListCount = 0 Then
MsgBox "没有可选择的字段，请另选择其它表！", vbOKOnly, "选择数值型字段"
Exit Sub
End If
If Combo3.Text = "" Then
MsgBox "没有选择字段，请选择要修改的字段！", vbOKOnly, "选择数值型字段"
Exit Sub
End If
Select Case Val(Text1)
Case 0 '系数a=0
If Val(Text2) = 0 Then
Formula = "0"
Else
Formula = Text2
End If
Case 1 '系数a=1
If Val(Text2) = 0 Then
Formula = Combo4
Else
If Val(Text2) < 0 Then
Formula = Combo4 + "-" + Str(Abs(Val(Text2)))
Else
Formula = Combo4 + "+" + Text2
End If
End If
Case Else '系数a<>0、1
If Val(Text2) = 0 Then
Formula = Text1 + "*" + Combo4
Else
If Val(Text2) < 0 Then
Formula = Text1 + "*" + Combo4 + "-" + Str(Abs(Val(Text2)))
Else
Formula = Text1 + "*" + Combo4 + "+" + Text2
End If
End If
End Select
Msg = " 修改公式为：" + Combo3 + "=" + Formula + vbCrLf + vbCrLf + "是否进行修改？"
Response = MsgBox(Msg, vbYesNo + vbInformation + vbDefaultButton2, "修改数据")
If Response = vbNo Then Exit Sub
If Option1 = True Then '全程修改记录
Do While Not DBTable.EOF
DBTable.Edit
DBTable.Fields(Combo3).Value = Val(Text1) *
DBTable.Fields(Combo4).Value + Val(Text2)
DBTable.Update
DBTable.MoveNext
Loop
DBTable.MoveFirst
Else '根据指定的记录范围修改记录
StartRec = IIf(Val(Text3) < Val(Text4), Val(Text3), Val(Text4))
EndRec = IIf(Val(Text3) > Val(Text4), Val(Text3), Val(Text4))
For i = 1 To StartRec - 1
DBTable.MoveNext
Next
For i = StartRec To EndRec
DBTable.Edit
DBTable.Fields(Combo3).Value = Val(Text1) *
DBTable.Fields(Combo4).Value + Val(Text2)
DBTable.Update
DBTable.MoveNext
Next
DBTable.MoveFirst
End If
Data1.Refresh
MSFlexGrid1.TextMatrix(0, 0) = "记录号" '增加固定列（记录号），以便根据记录号指定修改范围
For i = 1 To Data1.Recordset.RecordCount
MSFlexGrid1.TextMatrix(i, 0) = i
Next
For i = 0 To Data1.Recordset.Fields.Count '所有列居中对齐
MSFlexGrid1.ColAlignment(i) = 3
Next
Exit Sub
ErrDo:
MsgBox Error(Err), vbCritical, "修改数据"
Resume Next
End Sub
Private Sub Command3_Click() '退出系统
End
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path '指定运行记录文件目录
End Sub
Private Sub Dir1_Click()
File1.Path = Dir1.Path '指定运行记录文件目录
End Sub
Private Sub Drive1_Change()
On Error GoTo drivehandler
ChDrive Drive1.Drive
Dir1.Path = CurDir$
drivehandler:
Drive1.Drive = Dir1.Path
End Sub
Private Sub Combo1_Click()
Select Case Combo1.ListIndex
Case 0
File1.Pattern = "*.MDB"
Case 1
File1.Pattern = "*.*"
End Select
End Sub
Private Sub File1_Click()
On Error GoTo ErrDo
Dim n As String
Dim LastTabel As Integer
If Trim(File1.List(File1.ListIndex)) = "" Then Exit Sub
If Right(Dir1.Path, 1) = "\" Then
FileName = Dir1.Path & Trim(File1.List(File1.ListIndex))
Else
FileName = Dir1.Path & "\" & Trim(File1.List(File1.ListIndex))
End If
List1.Clear '清空字段列表框
Set File_db = OpenDatabase(FileName) '打开数据库
Tab_Num = File_db.TableDefs.Count '获数据库中表的个数
Combo2.Clear '清空表列表框
For i = 0 To Tab_Num - 1 '将库中所有的表添加到表列表框中（5个系统表除外）
n = File_db.TableDefs(i).Name
If n <> "MSysAccessObjects" And n <> "MSysACEs" And n <> "MSysObjects" And n <> "MSysQueries" And n <> "MSysRelationships" Then
Combo2.AddItem File_db.TableDefs(i).Name
LastTabel = i '记录最后一个表名，以便在表列表框中显示之
End If
Next
Combo2 = File_db.TableDefs(LastTabel).Name '在表列表框中显示表
Combo2_Click '在字段列表框中显示表中的字段
Exit Sub
ErrDo:
MsgBox Error(Err), vbCritical, "文件选择"
End Sub
Private Sub Form_Load()
Combo1.Text = "Access数据库文件(*.mdb)"
File1.Pattern = "*.mdb"
Combo1_Click
Dir1_Click
Text3.Enabled = False
Text4.Enabled = False
UpDown1.Enabled = False
UpDown2.Enabled = False
End Sub
Private Sub Option1_Click() '修改范围：全程
Text3.Enabled = False
Text4.Enabled = False
UpDown1.Enabled = False
UpDown2.Enabled = False
End Sub
Private Sub Option2_Click() '修改范围：从记录号...到记录号...
Text3.Enabled = True
Text4.Enabled = True
UpDown1.Enabled = True
UpDown2.Enabled = True
End Sub
Public Sub TextKeyPress(KeyAscii As Integer) '文本框输入合法性检查
Dim Style, Title, Msg, Response
If KeyAscii >= 33 Then
If KeyAscii <= vbKey9 And KeyAscii >= vbKey0 Then
Else
MsgBox "只能输入数字，其它字符无效！", vbCritical, "数据输入错误"
KeyAscii = 0
End If
End If
End Sub
Public Sub Text1_Text2_KeyPress(KeyAscii As Integer) '文本框输入合法性检查
Dim Style, Title, Msg, Response
If KeyAscii >= 33 Then
If KeyAscii <= vbKey9 And KeyAscii >= vbKey0 Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then
Else
MsgBox "只能输入数字，其它字符无效！", vbCritical, "数据输入错误"
KeyAscii = 0
End If
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) '文本框Text1输入合法性检查
Text1_Text2_KeyPress KeyAscii
End Sub
Private Sub Text1_LostFocus()
Text1 = Val(Text1)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) '文本框Text2输入合法性检查
Text1_Text2_KeyPress KeyAscii
End Sub
Private Sub Text2_LostFocus()
Text2 = Val(Text2)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer) '文本框Text3输入合法性检查
TextKeyPress KeyAscii
End Sub
Private Sub Text3_LostFocus() '文本框Text3输入合法性检查，保证数据在"1～记录数"之间
On Error Resume Next
If Data1.Recordset.Fields.Count = 0 Then
Text3 = 0 '无记录时，则取0
Else
If Val(Text3) <= 0 Then Text3 = 1 '有记录时，若最小值<1，则取1
If Val(Text3) > Data1.Recordset.RecordCount Then Text3 = Data1.Recordset.RecordCount '有记录时，若最大值超出记录数，则取记录数
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer) '文本框Text4输入合法性检查
TextKeyPress KeyAscii
End Sub
Private Sub Text4_LostFocus()'文本框Text4输入合法性检查，保证数据在"1～记录数"之间
On Error Resume Next
If Data1.Recordset.Fields.Count = 0 Then
Text4 = 0 '无记录时，则取0
Else
If Val(Text4) <= 0 Then Text4 = 1 '有记录时，若最小值<1，则取1
If Val(Text4) > Data1.Recordset.RecordCount Then Text4 = Data1.Recordset.RecordCount '有记录时，若最大值超出记录数，则取记录数
End If
End Sub
三、结论
本系统可修改任意Access数据库（特别适应于对工资表、学生成绩表、现场采集数据等数据表的批量修改），修改时不需要进入Access系统，在本系统中可直接进行修改并看到修改结果。系统运行步骤：①选择数据库文件(*.mdb)。②选择数据表，并显示表中所有字段信息。③指定修改范围，当选择“从记录号…到记录号…”方式时，应观察记录信息表中要修改的数值记录，决定记录的起止范围。④设置修改公式：y为需要修改的数值型字段；x与y相同或其它字段；系数a、b为任意数(可<0)，但多数情况下a=1。当a=0时，相当于数值替换。⑤所有设置完成后，按“修改数据”键进行修改。
|
