在Access中使用文件对话框导入Excel工作表

Option Compare Database
Option Explicit

Sub ImportExcel()
    Dim dlg As Object
    Dim filePath As String
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    Dim row As Integer
    Dim col As Integer

    ' 创建文件对话框对象
    Set dlg = Application.FileDialog(3)

    ' 设置文件对话框属性
    dlg.Title = "选择Excel文件"
    dlg.Filters.Clear
    dlg.Filters.Add "Excel文件", "*.xls;*.xlsx"

    ' 显示文件对话框
    If dlg.Show = -1 Then
        ' 获取选择的文件路径
        filePath = dlg.SelectedItems(1)

        ' 创建Excel对象
        Set excelApp = CreateObject("Excel.Application")
        Set excelWorkbook = excelApp.Workbooks.Open(filePath)

        ' 导入数据
        For Each excelWorksheet In excelWorkbook.Sheets
            ' 在表中添加新记录
            DoCmd.RunSQL "INSERT INTO TableName (Field1, Field2, Field3) VALUES ('" & excelWorksheet.Cells(row, col).Value & "', '" & excelWorksheet.Cells(row, col).Value & "', '" & excelWorksheet.Cells(row, col).Value & "')"
            ' 调整字段名称和对应的Excel工作表中的列
            ' 如有必要，请更改表名和字段名称以匹配数据库中的实际情况
        Next excelWorksheet

        ' 关闭Excel对象
        excelWorkbook.Close
        excelApp.Quit

        ' 释放资源
        Set excelWorksheet = Nothing
        Set excelWorkbook = Nothing
        Set excelApp = Nothing

        MsgBox "导入成功！"
    Else
        MsgBox "已取消导入。"
    End If

    ' 释放资源
    Set dlg = Nothing
End Sub