Access VBA中无文件打开权限时如何用Office FileDialog选择文件？

问题说明 #

Office自带的Application.FileDialog在选择文件时会验证文件的读取权限，因此当用户仅需记录文件路径但无打开权限时，无法选中目标文件，且该对话框没有内置设置可跳过权限检查。

替代方案：使用Windows API的GetOpenFileName函数 #

Windows原生的文件选择对话框API（GetOpenFileName）不会检查文件的访问权限，仅负责返回用户选中的文件路径，完全符合需求。以下是完整的VBA实现代码：

1. API声明（兼容32/64位Access） #

在模块顶部添加以下声明：

#If VBA7 Then
    Private Type OPENFILENAME
        lStructSize As LongPtr
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As LongPtr
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type

    Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#Else
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type

    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#End If

' 对话框常量
Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_EXPLORER As Long = &H80000

2. 自定义文件选择函数 #

添加以下函数，用于弹出对话框并返回选中的文件路径列表：

Function SelectFilesWithoutPermissionCheck() As Collection
    Dim ofn As OPENFILENAME
    Dim strFiles As String
    Dim arrFiles() As String
    Dim i As Integer
    Dim colFiles As New Collection
    
    ' 初始化对话框参数
    With ofn
        .lStructSize = Len(ofn)
        .hwndOwner = Application.hWndAccessApp
        .lpstrFilter = "所有文件 (*.*)" & vbNullChar & "*.*" & vbNullChar
        .lpstrTitle = "选择关联文件"
        .flags = OFN_ALLOWMULTISELECT Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_EXPLORER
        .nMaxFile = 32767
        .lpstrFile = String(.nMaxFile, vbNullChar)
    End With
    
    ' 弹出对话框
    If GetOpenFileName(ofn) Then
        strFiles = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
        
        ' 处理多选情况
        If InStr(strFiles, vbNullChar) > 0 Then
            arrFiles = Split(strFiles, vbNullChar)
            For i = 1 To UBound(arrFiles)
                colFiles.Add arrFiles(0) & "\" & arrFiles(i)
            Next i
        Else
            colFiles.Add strFiles
        End If
    End If
    
    Set SelectFilesWithoutPermissionCheck = colFiles
End Function

3. 使用示例 #

在窗体或模块中调用该函数，获取用户选中的文件路径：

Sub TestFileSelection()
    Dim selectedFiles As Collection
    Dim file As Variant
    
    Set selectedFiles = SelectFilesWithoutPermissionCheck()
    
    If selectedFiles.Count > 0 Then
        For Each file In selectedFiles
            ' 这里可以将路径写入记录表或进行其他处理
            Debug.Print "选中的文件路径：" & file
        Next file
    Else
        Debug.Print "未选中任何文件"
    End If
End Sub

方案优势 #

• 完全绕过文件权限检查，仅获取路径
• 支持多选文件，符合项目需求
• 兼容32位和64位版本的Access
• 对话框样式与系统原生保持一致，用户体验熟悉

内容的提问来源于stack exchange，提问作者Simon Graffe