excel vba 与access

下载access

电脑内存有限，下载了一个低版本的access2003。
51自学网对应课程有个开放的下载地址
下载好后直接安装就行。
打开access，新建一个test数据库。


test

excel vba连接access数据库

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With

    MsgBox "连接数据库成功"
End Sub

excel vba向access数据库插入数据

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection, sql As String
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '输入执行的sql语句，这里为插入一条数据
    sql = "insert into student values('001','张三',23)"
    con.Execute (sql)
    '释放连接
    con.Close
    Set con = Nothing
    MsgBox "执行成功"
End Sub

excel vba向access数据库删除数据

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection, sql As String
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '输入执行的sql语句，这里为删除一条数据
    sql = "delete from student where name='张三'"
    con.Execute (sql)
    '释放连接
    con.Close
    Set con = Nothing
    MsgBox "执行成功"
End Sub

excel vba向access数据库修改数据

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection, sql As String
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '输入执行的sql语句，这里为修改一条数据
    sql = "update student set age = 25 where name='张三'"
    con.Execute (sql)
    '释放连接
    con.Close
    Set con = Nothing
    MsgBox "执行成功"
End Sub

excel vba向access数据库查询数据

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection, studentRecordSet As New ADODB.recordSet, sql As String, i As Integer
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '输入执行的sql语句，这里为查询语句
    sql = "select * from student"
    '生成数据库查询结果集
    Set studentRecordSet = con.Execute(sql)
    '循环记录集的字段名，写入到excel中
    For i = 0 To studentRecordSet.Fields.Count - 1
        'Fields代表获取的所有字段名，从0开始递增，Name属性为字段名
        Cells(1, i + 1).Value = studentRecordSet.Fields(i).Name
    Next
    '将数据库查询到的数据显示到excel中
    Range("a2").CopyFromRecordset studentRecordSet
    '释放连接
    studentRecordSet.Close: Set studentRecordSet = Nothing
    con.Close: Set con = Nothing
    MsgBox "执行成功"
End Sub

excel vba使用RecordSet的open方法获得记录集

Option Explicit
Sub 连接数据库()
    '第一步：告诉电脑，我们要用ADO，就是引用ADO工具。点击工具-引用-勾选0biects 2.8Microsoft hetivex Data Obiects 6 1
    '第二步：创建连接对象
    '2-1：声明连接对象变量
    Dim con As ADODB.Connection, studentRecordSet As New ADODB.recordSet, sql As String, i As Integer
    '2-2：创建对象并赋值
    Set con = New ADODB.Connection
    '第三步：建立数据库连接
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '输入执行的sql语句，这里为查询语句
    sql = "select * from student"
    '生成数据库查询结果集，获得的对象是只读的，不能修改记录，不能获取查到数据的条数。
    'Set studentRecordSet = con.Execute(sql)
    
    '通过RecordSet的open方法获得记录集，获得的记录集可以修改，并且可以获取查询到数据的总条数
    studentRecordSet.Open sql, con, adOpenKeyset, adLockOptimistic
    
    '获取记录集的条数
    MsgBox studentRecordSet.RecordCount
    '数据写入到excel前，将excel表格清空
    '循环记录集的字段名，写入到excel中
    For i = 0 To studentRecordSet.Fields.Count - 1
        'Fields代表获取的所有字段名，从0开始递增，Name属性为字段名
        Cells(1, i + 1).Value = studentRecordSet.Fields(i).Name
    Next
    '将数据库查询到的数据显示到excel中
    Range("a2").CopyFromRecordset studentRecordSet
    '释放连接
    studentRecordSet.Close: Set studentRecordSet = Nothing
    con.Close: Set con = Nothing
    MsgBox "执行成功"
End Sub

excel vba增删改查小案例

image.png
Dim con As ADODB.Connection, studentRecordSet As ADODB.Recordset, itemDataArr As Variant
'关闭按钮对应的点击事件，点击后释放连接并且卸载窗口
Private Sub CommandButton1_Click()
    '按加载顺序反向关闭
    Set studentRecordSet = Nothing
    con.Close: Set con = Nothing
    Unload Me
End Sub


'第一步，打开表单时将所有的部门填充到listbox中
Private Sub UserForm_Initialize()
    Dim sql As String, i As Integer
    '窗体初始化时创建数据库连接对象，并建立链接
    Set con = New ADODB.Connection
    Set studentRecordSet = New ADODB.Recordset
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    sql = "select distinct apartment from student"
    studentRecordSet.Open sql, con, adOpenKeyset, adLockOptimistic
    For i = 1 To studentRecordSet.RecordCount
        ListBox1.AddItem studentRecordSet("apartment")
        studentRecordSet.MoveNext
    Next
    studentRecordSet.Close
End Sub
'第二步，点击的部门列表框，查询该部门对应的人员，填充到人员列表框中,itemDataArr为条目附加信息数组
Private Sub ListBox1_Click()
    Dim sql As String, i As Integer
    sql = "select id,name from student where apartment='" & ListBox1.Value & "'"
    '执行查询
    studentRecordSet.Open sql, con, adOpenKeyset, adLockOptimistic
    '重新定义附加数组大小
    ReDim itemDataArr(studentRecordSet.RecordCount - 1)
    ListBox2.Clear
    For i = 1 To studentRecordSet.RecordCount
        '将查询到的数据塞到人员列表框中，附加信息添加到附加数组中
        ListBox2.AddItem studentRecordSet("name")
        itemDataArr(i - 1) = studentRecordSet("id")
        studentRecordSet.MoveNext
    Next
    studentRecordSet.Close
End Sub
'第三步，点击人员列表框，查询对应人员信息，填充到文本框中
Private Sub ListBox2_Click()
    Dim sql As String
    sql = "select * from student where id = '" & itemDataArr(ListBox2.ListIndex) & "'"
     '执行查询
    studentRecordSet.Open sql, con, adOpenKeyset, adLockOptimistic
    TextBox1.Value = studentRecordSet("name")
    TextBox2.Value = studentRecordSet("age")
    TextBox3.Value = studentRecordSet("apartment")
    studentRecordSet.Close
End Sub

excel vba分页查询小案例


image.png
Dim con As ADODB.Connection, studentRecordSet As ADODB.Recordset, commonPageNum As Integer, totalPage As Integer
'选择分页大小
Private Sub ComboBox1_Change()
    Call RefreshForm(ComboBox1.Value, 1)
End Sub

'释放连接关闭窗口
Private Sub CommandButton1_Click()
'按加载顺序反向关闭
    Set studentRecordSet = Nothing
    con.Close: Set con = Nothing
    Unload Me
End Sub
'点击第一页
Private Sub CommandButton2_Click()
    Call RefreshForm(ComboBox1.Value, 1)
End Sub
'点击上一页
Private Sub CommandButton3_Click()
    If commonPageNum > 1 Then
         Call RefreshForm(ComboBox1.Value, commonPageNum - 1)
    End If
End Sub
'点击下一页
Private Sub CommandButton4_Click()
    If commonPageNum < totalPage Then
         Call RefreshForm(ComboBox1.Value, commonPageNum + 1)
    End If
End Sub
'点击最后一页
Private Sub CommandButton5_Click()
    Call RefreshForm(ComboBox1.Value, totalPage)
End Sub

Private Sub UserForm_Initialize()
    Dim i As Integer
 '窗体初始化时创建数据库连接对象，并建立链接
    Set con = New ADODB.Connection
    Set studentRecordSet = New ADODB.Recordset
    With con
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = ThisWorkbook.Path & "/test.mdb"
        .Open
    End With
    '初始化分页大小选择范围
    For i = 1 To 20
        ComboBox1.AddItem i
    Next
    '设置默认分页大小为5
    ComboBox1.Value = 5
    Call RefreshForm(5, 1)
End Sub

'刷新表单
Public Sub RefreshForm(pageSize As Integer, pageNum As Integer)
    Dim sql As String, i As Integer, listItem As listItem, j As Integer
    '记录pageNum
    commonPageNum = pageNum
    '查询分页数据:分页参考https://blog.csdn.net/lfq761204/article/details/127555263
    sql = "select top " & pageSize & " * from (select top " & pageNum * pageSize & " * from student order by id desc) order by id asc"
    '执行查询
    studentRecordSet.Open sql, con, adOpenKeyset, adLockOptimistic
    '生成表头
    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        '遍历查询到的数据表表头
        For i = 0 To studentRecordSet.Fields.Count - 1
        'Fields计数从零开始
        .ColumnHeaders.Add , , studentRecordSet.Fields(i).Name, .Width / studentRecordSet.Fields.Count
        Next
    End With
    '填入数据到表单
    With ListView1
        .ListItems.Clear
        '遍历查询到的数据
         For i = 1 To studentRecordSet.RecordCount
            Set listItem = .ListItems.Add
            listItem.Text = studentRecordSet.Fields(0).Value
            '遍历每条数据的每个字段
            For j = 1 To studentRecordSet.Fields.Count - 1
                listItem.SubItems(j) = studentRecordSet.Fields(j).Value
            Next
            studentRecordSet.MoveNext
         Next
    End With
    studentRecordSet.Close
    '查询总条数
    sql = "select count(*) as totalRecord from student"
    Set studentRecordSet = con.Execute(sql)
    totalPage = Application.WorksheetFunction.Ceiling(studentRecordSet("totalRecord") / pageSize, 1)
    TextBox1.Value = pageNum & "/" & totalPage
    studentRecordSet.Close
End Sub
最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
平台声明：文章内容（如有图片或视频亦包括在内）由作者上传并发布，文章内容仅代表作者本人观点，简书系信息发布平台，仅提供信息存储服务。

推荐阅读更多精彩内容