VB ADO与ACCESS数据库的链接,实现删除,添加,编辑..高分!!!

Question

要求:关于一个通讯录的管理程序,要求实现用ADO与ACCESS的连接,程序主界面上的几个按钮分别实现添加数据,删除数据,编辑数据,最好还能利用COMBO实现查找功能......好的我追加!!!!在线!!!QQ:736662838

Answer 1

你参考一下，应该对你有用

Dim cn As New ADODB.Connection

Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset

Dim rs As New ADODB.Recordset

Private Sub Cmdadd_Click(Index As Integer)

    Text1(0).Enabled = True

    Text1(0).SetFocus

    Data1.Recordset.AddNew    '数据库新增命令

    cmdfirst(0).Enabled = False   '设定各个控件的可用属性

    cmdpre(1).Enabled = False

    cmdnext(2).Enabled = False

    cmdlast(3).Enabled = False

    Cmdadd(0).Enabled = False

    cmddelete.Enabled = False

    cmdsave(5).Enabled = True

    cmdmend(4).Enabled = False

    Text1(6).Text = Data

End Sub

Private Sub cmddelete_Click()

Dim i As Integer

i = MsgBox("真的要删除当前记录吗？", vbYesNo, "警告")  '数据库的删除警告和相应命令

If i = 6 Then

    Data1.Recordset.Delete

    Data1.Refresh

    Call Form_Load

End If

End Sub

Private Sub cmdexit_Click(Index As Integer)

FormMain.Show

Unload Me

End Sub

Private Sub cmdfirst_Click(Index As Integer)

If Not Data1.Recordset.BOF Then

         Data1.Recordset.MoveFirst      '数据库移动到第一条

End If

End Sub

Private Sub cmdlast_Click(Index As Integer)

If Not Data1.Recordset.BOF Then

    Data1.Recordset.MoveLast            '数据库移动到最后一条

End If

End Sub

Private Sub cmdmend_Click(Index As Integer)

    Text1(0).Enabled = True     '设定各控件属性

    cmdsave(5).Enabled = True

    cmdmend(4).Enabled = False

End Sub

Private Sub cmdnext_Click(Index As Integer)

If Data1.Recordset.RecordCount <> 0 Then

        If Data1.Recordset.EOF = False Then Data1.Recordset.MoveNext  '数据库移动到下一条

            If Data1.Recordset.EOF = True Then   '判断数据库是否为最后一条

                Data1.Recordset.MoveLast

                MsgBox ("已经是最后一条")

            End If

    End If

End Sub

Private Sub cmdpre_Click(Index As Integer)

If Data1.Recordset.RecordCount <> 0 Then

            If Data1.Recordset.BOF = False Then

               Data1.Recordset.MovePrevious  '数据库移动到上一条

            End If

                If Data1.Recordset.BOF = True Then  '判断数据库是否为第一条

                    Data1.Recordset.MoveFirst

                    MsgBox ("已经是第一条")

                End If

            End If

End Sub

Private Sub cmdsave_Click(Index As Integer)

If Text1(0).Text = "" Or Text1(1).Text = "" Or Text1(2).Text = "" Or Text1(3).Text = "" Or Text1(4).Text = "" Or Text1(5).Text = "" Or Text1(6).Text = "" Then

        MsgBox "请完善数据！", , "提示"  '检测文本框中是否为空

        Exit Sub

    End If

'        Data1.Recordset.MoveLast

            Data1.UpdateRecord           '保存更新数据库

        MsgBox "数据保存成功！", , "提示"

            cmdfirst(0).Enabled = True      '设定个控件属性

            cmdpre(1).Enabled = True

            cmdnext(2).Enabled = True

            cmdlast(3).Enabled = True

            cmddelete.Enabled = True

            cmdmend(4).Enabled = True

            Call Form_Load

End Sub

Private Sub Comsx_Click()

Call Form_Load              '点击刷新，重新加载界面

End Sub

Private Sub Form_Load()

Dim i As Integer

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _

    & App.Path & "\Airplane.mdb;Persist Security Info=False"      '打开数据库

    rs1.Open "Airplane", cn, adOpenKeyset, adLockOptimistic       '打开数据库中的表文件

    If rs1.BOF Then

        MsgBox " 已经没有数据"                     '判断有没有数据

    Else

        Set MSHFlexGrid1.DataSource = rs1           '数据在MSHFlexGrid1控件中显示

        MSHFlexGrid1.ColWidth(0) = 100

        MSHFlexGrid1.ColWidth(6) = 2200

        For i = 1 To rs1.RecordCount

        MSHFlexGrid1.RowHeight(i) = 1500

        Next i

    End If

    rs1.Close

'Set DataGrid1.DataSource = Adodc1

    Cmdadd(0).Enabled = True

    cmdsave(5).Enabled = False

    Text1(0).Enabled = False

    cmdfirst(0).Enabled = True      '设定个控件属性

    cmdpre(1).Enabled = True

    cmdnext(2).Enabled = True

    cmdlast(3).Enabled = True

    cmddelete.Enabled = True

    cmdmend(4).Enabled = True

    Data1.Visible = False

cn.Close

End Sub

Answer 2

Private Sub Command1_Click()
Adodc1.Recordset.Fields("姓名") = Trim(Text1.Text)
Adodc1.Recordset.Fields("学号") = Trim(Text2.Text)
Adodc1.Recordset.Fields("电话") = Trim(Text3.Text)
Adodc1.Recordset.Fields("地址") = Trim(Text4.Text)
Adodc1.Recordset.Update
End Sub

Private Sub Command2_Click()
Dim YN As Integer
YN = MsgBox("确定删除?", vbYesNo)
If YN = 6 Then Adodc1.Recordset.Delete
End Sub

Private Sub Command3_Click()
Adodc1.Recordset.Fields("姓名") = Trim(Text1.Text)
Adodc1.Recordset.Fields("学号") = Trim(Text2.Text)
Adodc1.Recordset.Fields("电话") = Trim(Text3.Text)
Adodc1.Recordset.Fields("地址") = Trim(Text4.Text)
End Sub

Private Sub Command4_Click()
Adodc1.Recordset.CancelUpdate
Adodc1.Refresh
End Sub

Private Sub Command5_Click()
End
End Sub

Private Sub Command6_Click()
Adodc1.Recordset.AddNew
End Sub

Private Sub Command7_Click()
Adodc1.Recordset.Find Combo1.Text & "= '" & Trim(Text5) & "'", , , 1
If Adodc1.Recordset.EOF Then MsgBox "查找不到!!", , "提示"
End Sub

Private Sub Form_Load()
Dim constr As String
constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.mdb" & ";Persist Security Info=False"
Adodc1.ConnectionString = constr
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = "select * from 通讯录"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub

Answer 3

已发送一个列子到你QQ邮箱