如何用vba将excel单元格的数据导入access数据库表中?

要用vba将excel单元格的数据导入access数据库表中,可以有如下步骤:

  1. ADODB.Recordset数据集对象连接打开access数据库;
  2. ADODB.Recordset数据集对象的AddNew方法添加记录;
  3. 用ADODB.Recordset数据集对象的Update方法更新记录;
  4. 循环2-3;
  5. 用ADODB.Recordset数据集对象的Close方法关闭ADODB.Recordset数据集对象。

以下是一个通用的用vba将excel单元格的数据导入access数据库表中的代码:

Sub QQ1722187970()
    Const adOpenForwardOnly = 0
    Const adOpenKeyset = 1
    Const adOpenDynamic = 2
    Const adOpenStatic = 3
    Const adOpenUnspecified = -1
    Const adLockReadOnly = 1
    Const adLockPessimistic = 2
    Const adLockOptimistic = 3
    Const adLockBatchOptimistic = 4
    Const adLockUnspecified = -1
    Dim oRecordSet As Object
    Set oRecordSet = CreateObject("ADODB.Recordset")
    Dim sConstr As String
    Dim sPath As String
    Dim sTableName As String
    Dim sDataBase As String
    Dim sSql As String
    Dim oWK As Worksheet
    Set oWK = Excel.ActiveSheet
    '要导入的Access数据库中的表名
    sTableName = oWK.Name
    '要导入的Access文件名称
    sDataBase = "数据库"
    sPath = Excel.ThisWorkbook.Path & "\"
    sSql = "SELECT * FROM " & sTableName
     sVersion = Excel.Application.Version
    '创建连接字符串
    If sVersion <= 12 Then
        sConstr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & sPath & sDataBase & ".accdb"
    Else
        sConstr = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & sPath & sDataBase & ".accdb"
    End If
    With oRecordSet
        'open方法的第4个参数LockType是关键,否则不能添加记录
        .Open sSql, sConstr, adOpenForwardOnly, adLockOptimistic
        With oWK
            iCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            iRow = .Range("A" & .Rows.Count).End(xlUp).Row
                For i = 2 To iRow
                    With oRecordSet
                            .addnew
                            For j = 1 To iCol
                                sFieldName = oWK.Cells(1, j)
                                '用字段名的形式,excel数据源的字段顺序可以不跟access表中的一致
                                .Fields(sFieldName).Value = oWK.Cells(i, j)
                                'Fields集合的下标以0开始,用集合下标的形式,excel数据源的字段顺序必须跟access表中的一致
'                                .Fields(j).Value = oWK.Cells(i, j)
                            Next j
                            .Update
                    End With
                Next i
             
        End With
        .Close
        MsgBox "导入完成!"
    End With
    Set oRecordSet = Nothing
    Set oWK = Nothing
End Sub
       

发表评论