用vba将access导入mysql,如何用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