access数据库导入excel

Sub ImportExcelToAccess()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rs As DAO.Recordset
    Dim i As Integer, j As Integer
    Dim strSQL As String
    
    ' 打开 Excel 文件
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Open("C:\path\to\your\excel.xlsx")
    Set xlSheet = xlWB.Sheets(1)
    
    ' 打开 Access 数据库
    Set db = OpenDatabase("C:\path\to\your\database.accdb")
    
    ' 创建表结构
    Set tdf = db.CreateTableDef("ImportedData")
    tdf.Fields.Append tdf.CreateField("Field1", dbText)
    tdf.Fields.Append tdf.CreateField("Field2", dbInteger)
    db.TableDefs.Append tdf
    
    ' 插入数据
    Set rs = db.OpenRecordset("ImportedData")
    For i = 1 To xlSheet.UsedRange.Rows.Count
        rs.AddNew
        For j = 1 To xlSheet.UsedRange.Columns.Count
            rs.Fields(j - 1).Value = xlSheet.Cells(i, j).Value
        Next j
        rs.Update
    Next i
    
    ' 关闭连接
    rs.Close
    db.Close
    xlWB.Close
    xlApp.Quit
End Sub