form1.frm

国外的MDB数据库操作实例

End Sub

Private Sub Command3_Click()
'调用公用程序修改记录内容(此前需要点击要修改的记录,然后填上新的内容在text3和text4来配合完成)
Edit
'修改结束后清空text3和text4文本框
Text3.Text = ""
Text4.Text = ""
'调用公用程序LIST来查看被修改后的结果
List
End Sub

Private Sub Command4_Click()
' 调用公用的删除记录程序
Delete
'完成删除后调用LIST查看结果
List
End Sub

Private Sub Edit()
'这是修改记录子程序

'定义需要的变量
Dim DB As Database  '声明DB变量用于数据库
Dim RS As Recordset  '声明RS变量用于记录集
Dim WS As Workspace  '声明WS变量用于工作空间
Dim i As Long  '定义I用于下面的取得记录号

If List1.SelCount = 1 Then  '如果list1里面有选择的记录,那么

    '用I变量记录选择的那条记录号
    i = List1.ListIndex
    
    '定义工作空间
    Set WS = DBEngine.Workspaces(0)
    '定义数据库文件路径
    Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    '打开数据库,并选择里面的email表.
    Set RS = DB.OpenRecordset("email", dbOpenTable)
    
    '将记录指针移动到这条需要编辑的记录
    RS.Move i
    
    '声明RS要编辑这条记录
     RS.Edit
    
    '把数据库里的内容指向文本框text3和text4里的内容
    RS("Name") = Text3.Text
    RS("E-Mail") = Text4.Text
    
    '把结果更新到数据库
    RS.Update
    
    '关闭数据库
    DB.Close
Else
    MsgBox "请选择一个记录以便执行这项功能"  '如果没有选择任何记录,则显示这消息
    Exit Sub  '退出sub子程序
End If
End Sub


Private Function List()
'这是列出数据库记录的子程序

'定义需要的变量
Dim DB As Database  '声明DB变量用于数据库
Dim RS As Recordset  '声明RS变量用于记录集
Dim WS As Workspace  '声明WS变量用于工作空间
Dim Max As Long  '用于下面保存记录总和用的

    '定义工作空间
    Set WS = DBEngine.Workspaces(0)
    '定义数据库文件路径
    Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    '打开数据库,并选择里面的email表.
    'Set RS = DB.OpenRecordset("email", dbOpenTable)
    Set RS = DB.OpenRecordset("select * from email where name='wx'") '如果要用SQL，就加在里面执行


'用MAX变量得到记录总数
Max = RS.RecordCount

'BOF 指示当前记录位置位于 Recordset 对象的第一个记录之前。
'EOF 指示当前记录位置位于 Recordset 对象的最后一个记录之后。
'BOF 和 EOF 属性返回布尔型值。
RS.Move BOF  '因为刚才求了记录总和,指针跑到最后面去了,所以让指针回到开始去

'清空list1里面的内容
List1.Clear

'用循环列出表里面的所有记录
For i = 1 To Max
    '这儿将记录集一个个的写入list1列表框里面
    '这里用了一个!作为取得记录的方式,为什么后面的e-mail不用这个!呢,
    '可能是因为中间有个-号会被作为运算符对待吧
    List1.AddItem RS!Name & "," & RS("E-Mail")
    
    '指针移到下一记录
    RS.MoveNext
Next i

End Function

Public Function Delete()
'这是公用的删除记录子程序

'定义需要的变量
Dim DB As Database  '声明DB变量用于数据库
Dim RS As Recordset  '声明RS变量用于记录集
Dim WS As Workspace  '声明WS变量用于工作空间
Dim i As Long  '定义I用于下面的取得记录号


If List1.SelCount = 1 Then  '如果list1里面有选择的记录,那么

    '用I变量记录选择的那条记录号
    i = List1.ListIndex
    
    '定义工作空间
    Set WS = DBEngine.Workspaces(0)
    '定义数据库文件路径
    Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    '打开数据库,并选择里面的email表.
    Set RS = DB.OpenRecordset("email", dbOpenTable)
    
    '指针移到记录I
    RS.Move i
    
    '执行删除
    RS.Delete
           
    '关闭记录
    DB.Close
Else
    MsgBox "还没有选择一条记录"
    Exit Function '退出子程序
End If

End Function

Private Sub Command5_Click()
'执行添加一个表在MDB里面
Add_Table
End Sub

Public Function Add_Table()
'This function will show how to delete records

'Dim our variables
Dim DB As Database
Dim WS As Workspace
Dim TD As TableDef
Dim FD1 As Field
Dim FD2 As Field
Dim FD3 As Field

'This sets a workspace for the database
Set WS = DBEngine.Workspaces(0)
'this opens the database
Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    
'Set the table info
Set TD = DB.CreateTableDef(Text5.Text)
           
'create new fields and bind it to the table.
'For the dbText, you can use dbInteger or whatever else
'you wish to set the field type to. I would stick with those
'2 though.
Set FD1 = TD.CreateField(Text6.Text, dbText)
Set FD2 = TD.CreateField(Text7.Text, dbText)
Set FD3 = TD.CreateField(Text8.Text, dbText)

'bind the Fields to the table
TD.Fields.Append FD1
TD.Fields.Append FD2
TD.Fields.Append FD3

'Now bind the table to the database
DB.TableDefs.Append TD

'close the database
DB.Close

End Function

Private Sub Command6_Click()
'Call add field function
Add_Field
End Sub

Public Function Add_Field()
'This function will show how to delete records

'Dim our variables
Dim DB As Database
Dim WS As Workspace
Dim TD As TableDef
Dim FD As Field

'This sets a workspace for the database
Set WS = DBEngine.Workspaces(0)
'this opens the database
Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    
'Set the table to open
Set TD = DB.TableDefs(Text10.Text)

'Once again, you can use dbText, or dbInterger
'or whatever else you wish to set the field type
Set FD = TD.CreateField(Text9.Text, dbText)

'Bind field to the table
TD.Fields.Append FD

'close the database
DB.Close

End Function

Public Function Delete_Field()
'This function will show how to delete records

'Dim our variables
Dim DB As Database
Dim WS As Workspace
Dim TD As TableDef
Dim FD As Field

'This sets a workspace for the database
Set WS = DBEngine.Workspaces(0)
'this opens the database
Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    
'Set the table to open
Set TD = DB.TableDefs(Text10.Text)

'Erase the field
TD.Fields.Delete Text9.Text

'close the database
DB.Close

End Function

Private Sub Command7_Click()
'call the delete field function
Delete_Field
End Sub

Private Sub Command8_Click()
'call the delete table function
Delete_Table
End Sub

Public Function Delete_Table()
'This function will show how to delete records

'Dim our variables
Dim DB As Database
Dim WS As Workspace
Dim TD As TableDef
Dim FD As Field

'This sets a workspace for the database
Set WS = DBEngine.Workspaces(0)
'this opens the database
Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    
'Set the table to open
DB.TableDefs.Delete Text5.Text

'close the database
DB.Close

End Function

Private Sub Command9_Click()

'call the list tables function
list_Tables
End Sub

Public Function list_Tables()
'This function will show how to list tables in a database

List2.Clear

'Dim our variables
Dim DB As Database
Dim WS As Workspace
Dim TD As TableDef
Dim Temp As String
Dim Max As Long


'This sets a workspace for the database
Set WS = DBEngine.Workspaces(0)
'this opens the database
Set DB = WS.OpenDatabase(App.Path & "\dbtut.mdb")
    

    
'find the number of tables in the database
Max = DB.TableDefs.Count

For i = 0 To Max - 6
'Take away six from max because the last 5
'are not for you to mess with

'select the table
Set TD = DB.TableDefs(i)

'List the tables in the listbox
List2.AddItem TD.Name

Next i

'close the database
DB.Close

End Function

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub