20161208xlVBA工作表数据导入Access

Sub InsertToDataBase()

    Dim DataPath As String
    Dim SQL As String
    Const DataName As String = "yunying.mdb"
    Const TableName As String = "关键词效果分析"

    DataPath = ThisWorkbook.Path & "\" & DataName

    Dim Rng As Range
    Dim Arr As Variant
    Dim EndRow As Long
    Dim Fileds As String
    Dim Values As String

    With ThisWorkbook.Worksheets(1)
        EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range("A1:R" & EndRow)
        Arr = Rng.Value

        For i = 2 To Rng.Rows.Count
            Fileds = ""
            Values = ""
            For j = 1 To 6
                Fileds = Fileds & Arr(1, j) & ","
                Values = Values & "'" & Arr(i, j) & "'," '数值转为文本
            Next j

            For j = 7 To Rng.Columns.Count
                Fileds = Fileds & Arr(1, j) & ","
                Values = Values & Arr(i, j) & ","
            Next j

            Fileds = Left(Fileds, Len(Fileds) - 1)
            Values = Left(Values, Len(Values) - 1)

            SQL = "INSERT INTO " & TableName & " (" & Fileds & ") VALUES(" & Values & ")"

            Debug.Print SQL
            CnnRunSQL DataPath, SQL

            'If i = 2 Then Exit Sub
        Next i
    End With
    Set Rng = Nothing
End Sub
Sub CnnRunSQL(ByVal DataPath As String, ByVal SQL As String)
'对象变量声明
    Dim CNN As Object
    Dim RS As Object
    '数据库引擎——Excel作为数据源
    Const DATA_ENGINE As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    '创建ADO Connection 连接器 实例
    Set CNN = CreateObject("ADODB.Connection")
    ' On Error Resume Next
    '创建 ADO RecordSet  记录集 实例
    'Set RS = CreateObject("ADODB.RecordSet")
    '连接数据源
    CNN.Open DATA_ENGINE & DataPath
    '执行查询 返回记录集

     CNN.Execute (SQL)
    'RS.Open SQL, CNN, 1, 1
    '关闭记录集
    'RS.Close
    '关闭连接器
    CNN.Close
    '释放对象
    Set RS = Nothing
    Set CNN = Nothing
End Sub