玉管通地理,朱笔点天文
        欢迎光临文天软件之家
 
全站搜索
联系方式


网 址:文天软件之家

    www.jh-lzf.com

联系人:文天(刘中甫)

邮 箱:jh-lzf@21cn.com

地 址:湖北·武汉

    中国石化·江汉油田

    石油工程技术研究院

    信息中心

  

天气信息
新闻详情
为Access扩充数值记录批量修改功能
来源:━━━━《电脑编程技巧与维护》2004第1期作者:刘中甫网址:http://www.jh-lzf.com浏览数:4

为Access扩充数值记录批量修改功能

摘  要:本文介绍了“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时,相当于数值替换。⑤所有设置完成后,按“修改数据”键进行修改。