VBA中Excel FileDialogFilePicker弹窗两次问题求助

你的代码里两次调用了Application.FileDialog(msoFileDialogFilePicker)：

1. Select_form过程中弹出第一个文件选择对话框
2. 调用openDataFile函数时，函数内部又弹出一次文件选择对话框

这就是运行代码时连续弹出两次对话框的原因。

根据实际需求选择对应处理方式：

方式一：只需要选择一次文件（推荐） #

如果「hazard form」就是你要提取数据的目标文件，直接把第一次选择的路径传递给openDataFile函数，去掉函数内部的重复对话框即可：

修改后的完整代码：

Option Explicit

Sub Select_form()
    Dim FilePicker As FileDialog
    Dim mypath As String
    Dim formwb As Workbook

    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
        .Title = "Please select the hazard form"
        .AllowMultiSelect = False
        .ButtonName = "Confirm selection"
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls*" ' 统一过滤Excel格式文件
        If .Show = -1 Then
            mypath = .SelectedItems(1)
        Else
            Exit Sub ' 用Exit Sub替代End，避免直接终止整个程序
        End If
    End With

    Set formwb = openDataFile(mypath) ' 将已选路径传递给函数
    Debug.Print formwb.Name
End Sub

Function openDataFile(filePath As String) As Workbook
    Dim wb As Workbook
    
    ' 校验文件是否存在
    If Dir(filePath) = "" Then
        MsgBox "选择的文件不存在！", vbExclamation, "Warning"
        Exit Function
    End If
    
    Set openDataFile = Workbooks.Open(filePath)
End Function

方式二：确实需要两次选择（排查误触发） #

如果业务逻辑必须选择两个不同文件，可添加调试输出确认代码调用流程，同时优化函数逻辑避免异常：

Option Explicit

Sub Select_form()
    Dim FilePicker As FileDialog
    Dim mypath As String
    Dim formwb As Workbook

    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
        .Title = "Please select the hazard form"
        .AllowMultiSelect = False
        .ButtonName = "Confirm selection"
        If .Show = -1 Then
            mypath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    Debug.Print "已选hazard form路径：" & mypath
    Set formwb = openDataFile()
    Debug.Print "已选数据文件名称：" & formwb.Name
End Sub

Function openDataFile() As Workbook
    Dim filename As String
    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = False
        .Title = "Select the file to extract data"
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls*"
        If .Show <> -1 Then
            MsgBox "No Excel file was selected !", vbExclamation, "Warning"
            Exit Function
        End If
        filename = .SelectedItems(1)
    End With

    Set openDataFile = Workbooks.Open(filename)
End Function

• 方式一通过参数传递路径彻底消除重复弹窗
• 用Exit Sub/Exit Function替代End，避免直接终止整个VBA程序导致资源泄漏
• 统一添加Excel文件过滤规则，降低用户选错文件的概率

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