用vba实现选取任意路径下的excel表格文件，将选择的文件数据导出到access，并保存相同名称的mdb文件到相同的目录

以下是一个简单的VBA代码示例，用于从Excel文件中导出数据并将其保存到Access数据库中。您可以根据自己的需求进行修改：

Sub ImportDataToAccess()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strDBPath As String
    Dim strTableName As String
    Dim strFilePath As String
    Dim strFileName As String
    Dim strSQL As String
    Dim i As Integer
    
    '选择Excel文件
    strFilePath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    If strFilePath = "" Then Exit Sub
    
    '获取文件名和路径
    strFileName = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
    strTableName = Left(strFileName, InStrRev(strFileName, ".") - 1)
    strDBPath = Left(strFilePath, InStrRev(strFilePath, "\"))
    
    '连接Access数据库
    Set db = OpenDatabase(strDBPath & strTableName & ".mdb")
    
    '创建表
    strSQL = "CREATE TABLE [" & strTableName & "] ("
    For i = 1 To ActiveSheet.UsedRange.Columns.Count
        strSQL = strSQL & "[" & ActiveSheet.Cells(1, i).Value & "] TEXT(255), "
    Next i
    strSQL = Left(strSQL, Len(strSQL) - 2) & ")"
    db.Execute strSQL
    
    '导入数据
    Set rs = db.OpenRecordset(strTableName, dbOpenTable)
    With ActiveSheet
        For i = 2 To .UsedRange.Rows.Count
            rs.AddNew
            For j = 1 To .UsedRange.Columns.Count
                rs(.Cells(1, j).Value) = .Cells(i, j).Value
            Next j
            rs.Update
        Next i
    End With
    
    '关闭连接
    rs.Close
    db.Close
    
    '保存Access文件
    Application.DisplayAlerts = False
    Application.SaveAsText acForm, strDBPath & strTableName & ".mdb", acExportAll
    Application.DisplayAlerts = True
    
    '提示完成
    MsgBox "数据导入成功！"

End Sub

请注意，此代码仅适用于将Excel文件中的数据导入到新创建的Access数据库中，并将其保存为与Excel文件相同的名称。如果您需要将数据导入到现有的Access数据库中或使用不同的表格名称和/或数据库名称，请相应地修改代码。