access数据库数据导入

Sub ImportFromExcel()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim xlsApp As Object
    Dim xlsWB As Object
    Dim xlsRange As Object
    Dim i As Integer
    
    ' 打开 Access 数据库
    Set db = OpenDatabase("C:\path\to\your\database.accdb")
    
    ' 创建一个新的表
    Set tdf = db.CreateTableDef("NewTable")
    tdf.Fields.Append tdf.CreateField("Field1", dbText)
    tdf.Fields.Append tdf.CreateField("Field2", dbInteger)
    db.TableDefs.Append tdf
    
    ' 打开 Excel 文件
    Set xlsApp = CreateObject("Excel.Application")
    Set xlsWB = xlsApp.Workbooks.Open("C:\path\to\your\file.xlsx")
    Set xlsRange = xlsWB.Sheets(1).Range("A1:B10")
    
    ' 导入数据
    For i = 1 To xlsRange.Rows.Count
        db.Execute "INSERT INTO NewTable (Field1, Field2) VALUES ('" & xlsRange.Cells(i, 1).Value & "', " & xlsRange.Cells(i, 2).Value & ")"
    Next i
    
    ' 关闭 Excel 文件和 Access 数据库
    xlsWB.Close SaveChanges:=False
    xlsApp.Quit
    db.Close
End Sub