高本汉:VB 数据库操作(转)

Public DB As New Connection   'ado对象中的连接对象
Public Rs As New Recordset    'ado对象中的记录集合对象

'增加记录
Private Sub Command1_Click()
    Form2.Command2.Visible = False
    Form2.Command1.Visible = True
    Form2.Show 1   '显示添加窗口
End Sub

'编辑记录
Private Sub Command2_Click()
    '打开记录
    Dim i As Integer
    If fg.TextMatrix(fg.Row, 0) = "" Then Exit Sub '未选中任何记录
    Set Rs = DB.Execute("select * from 测试表 where 姓名='" & fg.TextMatrix(fg.Row, 0) & "'")
    Load Form2
    '填充编辑表的各字段
    For i = 0 To 5
        Form2.Text1(i).Text = Rs.Fields(i)
    Next i
    Rs.Close
    Form2.Command1.Visible = False
    Form2.Command2.Visible = True
   
    Form2.Show 1
End Sub

Private Sub Command3_Click()
    '删除指定记录
    If fg.TextMatrix(fg.Row, 0) = "" Then Exit Sub '未选中任何记录
    DB.Execute "delete * from 测试表 where 姓名='" & fg.TextMatrix(fg.Row, 0) & "'"
    MsgBox "删除完毕"
    Fillfg
End Sub

'双击表格，调用编辑功能...
Private Sub fg_DblClick()
    Command2_Click
End Sub

'程序入口
Public Sub Form_Load()
    DB.CursorLocation = adUseClient '设置数据库为本地数据库
    '打开数据库
    DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=cs.mdb;"
    Call Fillfg '调用子程序
End Sub

Public Sub Fillfg() '填充表格内容的子程序
    '初始化fg表格
    fg.Clear
    fg.Rows = 2
    fg.Cols = 6
    fg.TextMatrix(0, 0) = "姓名"
    fg.TextMatrix(0, 1) = "年龄"
    fg.TextMatrix(0, 2) = "性别"
    fg.TextMatrix(0, 3) = "身高"
    fg.TextMatrix(0, 4) = "嗜好"
    fg.TextMatrix(0, 5) = "备注"
    'fg为表格控件,textmatrix属性为表格控件中某个单元格的内容文本，
    '其中,第一个参数为行号，从0开始，第二个参数为列号也从0开始，

    '按SQL查询返回查询结果
    Set Rs = DB.Execute("select * from 测试表")
    If Not Rs.EOF Then Set fg.DataSource = Rs
    Rs.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DB.Close
End Sub

*******************************************************************************************

form2

*******************************************************************************************

Private Sub Command1_Click()
    '添加记录
    On Error GoTo 错误
   
    '使用SQL语句插入
    Form1.DB.Execute "insert into 测试表 values('" & Text1(0).Text & _
                        "','" & Text1(1).Text & _
                        "','" & Text1(2).Text & _
                        "','" & Text1(3).Text & _
                        "','" & Text1(4).Text & _
                        "','" & Text1(5).Text & "')"
   
    Form1.Fillfg '刷新fg
    MsgBox "添加完毕"
    Unload Me '关闭本窗口
    Exit Sub
错误:
    Select Case Err.Number
    Case -2147467259
        MsgBox Err.Description
        Set Form1.Rs = Nothing
    Case Else
        MsgBox Err.Number
    End Select

End Sub

'更新记录
Private Sub Command2_Click()
    On Error GoTo 错误
    '使用SQL语句更新
    Form1.DB.Execute "update 测试表 set 姓名='" & Text1(0).Text & _
                        "',年龄='" & Text1(1).Text & _
                        "',性别='" & Text1(2).Text & _
                        "',身高='" & Text1(3).Text & _
                        "',嗜好='" & Text1(4).Text & _
                        "',备注='" & Text1(5).Text & _
                        "' where 姓名='" & Form1.fg.TextMatrix(Form1.fg.Row, 0) & "'"
   
    Form1.Fillfg '刷新fg
    MsgBox "更新完毕"
    Unload Me '关闭本窗口
    Exit Sub
错误:
    Select Case Err.Number
    Case -2147467259
        MsgBox Err.Description
        Set Form1.Rs = Nothing
    Case Else
        MsgBox Err.Number & Err.Description
    End Select
   
End Sub