用户选择的文件目录访问 VBA

Question

我目前正在使用下面的代码将一个充满 excel 个文件的文件夹导入到 Access 中。我想将宏导出给其他人，但使用硬编码路径对其他人不起作用。但我不确定如何更改路径以接受用户输入我想尝试制作类似文件浏览器的东西，但不确定如何做。

Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean

' accept excel first line as headers for tables
blnHasFieldNames = True

' Path to files
strpath = "C:\Users\MyName\Desktop\Test\"


strFile = Dir(strpath & "*.xls")

'import all files within selected folder
Do While Len(strFile) > 0
strPathFile = strpath & strFile
strTable = Left(strFile, Len(strFile) - 5)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop

以下是我尝试更改的内容，但出现 "Method 'filedialog' of object_'Application' failed" 错误并且不确定我是否使用不正确。

strpath = Application.FileDialog(msoFileDialogFilePicker)

Answer 1

感谢 HansUp 帮助解决这个问题。

到select文件夹并上传文件夹内的所有文件如下...

Const msoFileDialogFolderPicker As Long = 4
Dim objfiledialog As Object
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean

' accept excel first line as headers for tables
blnHasFieldNames = True

'select folder and set path
Set objfiledialog = Application.FileDialog(msoFileDialogFolderPicker)

With objfiledialog
.AllowMultiSelect = False
If .Show Then
 strpath = .SelectedItems(1) & Chr(92)
 End If
End With

strFile = Dir(strpath & "*.xls")

'import all files within selected folder
Do While Len(strFile) > 0
strPathFile = strpath & strFile
strTable = Left(strFile, Len(strFile) - 5)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop

用户选择的文件目录访问 VBA

User chosen file directory Access VBA

ms-access

vba

ms-access-2010