VBA ADO连接ACCESS数据库

hksxg

一、ACCESS数据库加密
1、ACCESS 2013数据库加密方式
（1）使用旧版加密（适用于反向兼容和多用户数据）
（2）使用默认加密（安全性较高）
ADO连接仅支持旧版加密，使用VBA代码动态创建带密码的Access 数据库文件，也是旧版加密。
2、数据库如果采用手工设置密码，则要设置为旧版加密方式：
打开ACCESS 2013—Access选项—客户端设置—加密方法--使用旧版加密（适用于反向兼容和多用户数据）
二、设置ADO连接ACCESS数据库方式一
（1）引用 Microsoft ActiveX Data Objects 2.x Library（操作方式：Visual Basic-工具-引用，不同office版本不同）
  说明：当未引用，运行后会显示“用户定义类型未定义”
（2）连接代码
Sub 导入数据1()
    Dim cnn As ADODB.Connection      '数据库连接
    Dim mydata As String                   '数据库的完整路径和名称
    Dim mytable As String                  '数据表名称
    Dim sql As String                         'sql语句
    Dim rs As ADODB.Recordset          '临时数据表纪录
    Dim i As Integer                           '循环数据变量（获取数据表字段）

    '1、连接数据库
    Set cnn = New ADODB.Connection
    mydata = ThisWorkbook.Path & "\进销存数据库.accdb"

    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password='123456'"
        .Open mydata
    End With

    '2、建立与数据库的连接
    mytable = "采购数据3"
    sql = "select 采购数据3.ID,采购数据3.采购日期,采购数据3.供货类型,采购数据3.采购分类,采购数据3.供应商,采购数据3.名称,采购数据3.单位,采购数据3.单价,采购数据3.数量,采购数据3.金额,采购数据3.入账日期" & " from " & mytable & " order by 采购日期"
    Set rs = New ADODB.Recordset
    rs.Open sql, cnn, adOpenKeyset, adLockOptimistic

     '3、复制数据库数据
    ' (1)清除原数据
    ActiveSheet.Cells.ClearContents

    '（2）复制字段名
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i

    '（3）复制全部数据
    Range("A2").CopyFromRecordset rs

    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing

End Sub


三、设置ADO连接ACCESS数据库方式二
无需引用，直接创建连接
Sub 导入数据2()
    Dim cnn As Object                '数据库连接
    Dim strcnn As String             'ACCESS连接语句
    Dim mydata As String            '数据库的完整路径和名称
    Dim mytable As String           '数据表名称
    Dim sql As String                  'sql查询语句
    Dim rs As Object                  '临时数据表纪录
    Dim i As Integer                  '循环数据变量（获取数据表字段）

    '1、连接数据库
    Set cnn = CreateObject("ADODB.Connection")
    mydata = ThisWorkbook.Path & "\进销存数据库.accdb"

    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
        Case Is <= 11
            strcnn = "Provider=Microsoft.Jet.Oledb.4.0;Jet OLEDB:Database Password='123456';Data Source=" & mydata
        Case Is >= 12
            strcnn = "Provider=Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password='123456';Data Source=" & mydata
    End Select

    cnn.Open strcnn    '打开数据库链接

    '2、设置sql查询语句
    mytable = "采购数据3"
    Set rs = CreateObject("ADODB.Recordset")

    sql = "select 采购数据3.ID,采购数据3.采购日期,采购数据3.供货类型,采购数据3.采购分类,采购数据3.供应商,采购数据3.名称,采购数据3.单位,采购数据3.单价,采购数据3.数量,采购数据3.金额,采购数据3.入账日期" & " from " & mytable & " order by 采购日期"
    Set rs = cnn.Execute(sql)    '执行查询，并将结果输出到记录集对象

    '3、复制数据库数据

    With ActiveSheet
        .Cells.ClearContents

        For i = 0 To rs.Fields.Count - 1    '填写标题
            .Cells(1, i + 1) = rs.Fields(i).Name
        Next i

        .Range("A2").CopyFromRecordset rs

        '.Cells.EntireColumn.AutoFit  '自动调整列宽
        '.Cells.EntireColumn.AutoFit  '自动调整列宽

    End With


    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing

End Sub

little-key

这个可以作为常用的模块还是不错的

lawrencespk

如果连入的对象是mysql, 应该要用什么方法能够达到近判断新数据并且上传至mysql呢?

ardu95

学习。
感谢楼主

arson006

有记号 相当有用

chis3

我公司都不提供access呢,只用excel作數據庫
但也難保不會用,先收藏了

qinyu0745

做个记号，有参考作用，谢

muyuangan

之前 用了很多方法，都连不上数据库。经测试，楼主方法好用。感谢分享！

kxlong3134

收藏备用先

warton01

收藏备用先+1