如何使用文件对话框将文件路径保存在字符串中，使用 Access VBA？

Question

我有一个 Access 文件，我将使用它来保证数据的质量。

我将从三个 Excel 文件中输入数据，每个文件都有自己的 Access 表。

目前我有三个按钮和对应的文本框。我在文本框中手动输入文件路径和名称，单击按钮，完成宏的其余部分，导入数据。

我想使用文件选择器对话框来用路径填充文本框。

Answer 1

这段代码对我有用：

Private Sub Comando32_Click()
    Dim f As Object
    Dim strFile As String
    Dim strFolder As String
    Dim varItem As Variant

    Set f = Application.FileDialog(3)
    f.AllowMultiSelect = False

    If f.Show Then
        For Each varItem In f.SelectedItems
            strFile = Dir(varItem)
            strFolder = Left(varItem, Len(varItem) - Len(strFile))
            MsgBox "Folder: " & strFolder & vbCrLf & _
                "File: " & strFile
            Me.certidao.Value = varItem
        Next
    End If
    Set f = Nothing
End Sub

Answer 2

当然可以在VBA中调用文件Dialog API！

直接来自 Microsoft VBA 文档的示例：

Private Sub cmdFileDialog_Click() 

   ' Requires reference to Microsoft Office XY.0 Object Library. 

   Dim fDialog As Office.FileDialog 
   Dim varFile As Variant 

   ' Clear listbox contents. 
   Me.FileList.RowSource = "" 

   ' Set up the File Dialog. 
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker) 

   With fDialog 

      ' Allow user to make multiple selections in dialog box 
      .AllowMultiSelect = True 

      ' Set the title of the dialog box. 
      .Title = "Please select one or more files" 

      ' Clear out the current filters, and add our own. 
      .Filters.Clear 
      .Filters.Add "Access Databases", "*.MDB" 
      .Filters.Add "Access Projects", "*.ADP" 
      .Filters.Add "All Files", "*.*" 

      ' Show the dialog box. If the .Show method returns True, the 
      ' user picked at least one file. If the .Show method returns 
      ' False, the user clicked Cancel. 
      If .Show = True Then 

         'Loop through each file selected and add it to our list box. 
         For Each varFile In .SelectedItems 
            Me.FileList.AddItem varFile 
         Next 

      Else 
         MsgBox "You clicked Cancel in the file dialog box." 
      End If 
   End With 
End Sub

请注意，您必须包含对 Microsoft Office 11.0 库的引用 （在代码窗口中，选择菜单选项 Tools, Reference 并选择您的库以获得正确版本的 Office 版本）

Answer 3

感谢您的回复。

我先用谷歌搜索了它，然后尝试了我遇到的所有东西。我还遇到了上面粘贴的那组代码。我玩了一段时间，无论我做什么都会返回错误。我决定在 Excel 中而不是 Access 中尝试代码，它立即起作用。我唯一能想到的是代码不适用于访问。在所有这些之后，我在这里提出了这个问题。

Private Sub cmdDialog_Click()

   Dim fDialog As Office.FileDialog
   Dim varFile As Variant

   Me.txtFileSelect.RowSource = ""

   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

   With fDialog

      .AllowMultiSelect = False
      .Title = "Please select one or more files"

      .Filters.Clear
      .Filters.Add "Excel Files", "*.XLSX"
      .Filters.Add "All Files", "*.*"

      If .Show = True Then

         For Each varFile In .SelectedItems
            Me.txtFileSelect.AddItem varFile
         Next

      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Sub

使用此代码，我得到： 编译错误； 未识别用户定义类型

Answer 4

试试这个代码，单个文件：

MyFileURL = aBrowseForFile("C:\users\") 


Public Function aBrowseForFile(aStartFolder As String) As String

' Needs a reference to Microsoft Office Object Library 15.0

On Error GoTo Err_txtBrowseForFile

Dim fDialog As Office.FileDialog
Dim varfile As Variant
Dim strPath As String
Dim strFilter As String, strFileName As String
Dim Main_Dir As String, DefFolder As String


Set fDialog = Application.FileDialog(msoFileDialogFilePicker)


With fDialog
    .InitialView = msoFileDialogViewThumbnail
    .AllowMultiSelect = False
    .Title = "Please select one or more files"
    .InitialFileName = aStartFolder
    .InitialView = msoFileDialogViewThumbnail
    .Filters.Clear
    .Filters.Add "all files", "*.*"


     ' Show the dialog box. If the .Show method returns True, the
     ' user picked at least one file. If the .Show method returns
     ' False, the user clicked Cancel.

    If .Show = True Then
         aBrowseForFile = .SelectedItems(1)
    Else
        'MsgBox "You clicked Cancel in the file dialog box."
    End If
  End With

Exit_txtBrowseForFile:
       Exit Function

Err_txtBrowseForFile:
       MsgBox Err.Description, vbCritical, "MyApp"
       Resume Exit_txtBrowseForFile

    End Function

把这个函数按原样放在一个模块中。 不要在里面放一些其他代码，这样你可以在其他项目中调用它并构建你自己的工具集。

如上所示在您的表单中调用它。

这段代码运行良好，已经过测试。

如果要查看这段代码，在调试窗口中输入

debug.print aBrowseForFile("C:\users\") 

看看会发生什么。如果您有其他运行时或编译错误，请发布另一个问题。

希望对你有帮助

Answer 5

感谢您的回复。

我最终解决了这个问题，我没有选择对象数据库。我发现以下代码可以工作：

Private Sub cmdInput_Click()

   Dim fDialog As Office.FileDialog
   Dim varFile As Variant

   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

   With fDialog

      .AllowMultiSelect = False
      .Title = "Please select a file"

      .Filters.Clear
      .Filters.Add "Excel Files", "*.XLSX"
      .Filters.Add "All Files", "*.*"

If .Show = True Then

For Each varFile In .SelectedItems

    DoCmd.TransferSpreadsheet acImport, 10, "InputData", varFile, True, ""
    Beep

    MsgBox "Import Complete!", vbExclamation, ""

Next
Else
         MsgBox "You clicked Cancel in the file dialog box."
End If

   End With

End Sub