如何避免源工作簿打开时执行VBA代码弹出文件选择对话框？

问题原因 #

当源工作簿处于打开状态时，代码仍使用带完整路径的外部引用格式，Excel解析该路径时会触发文件选择对话框；关闭对话框后代码能正常运行，是因为Excel最终识别到已打开的工作簿并完成数据读取。

修复方案 #

修改代码，先检查源工作簿是否已打开：若打开则直接通过工作簿对象引用数据，未打开则使用原路径公式读取，以此避免弹出文件选择框。

修改后的代码：

Sub CollectExternalData()
On Error GoTo codeErr

'---> PURPOSE: Loads cell data from another spreadsheet
Dim sPath As String
Dim rTarget As Range
Dim wbSource As Workbook
Dim sourceSheet As Worksheet
Dim sourceRange As Range

'---> 源文件信息常量定义
Const WB_NAME As String = "FileName.xlsx"
Const SHEET_NAME As String = "SheetName"
Const SOURCE_RANGE As String = "$A$1:$A$20"
Const TARGET_RANGE As String = "A1:A20"

Set rTarget = ActiveSheet.Range(TARGET_RANGE)

'---> 检查源工作簿是否已打开
On Error Resume Next
Set wbSource = Workbooks(WB_NAME)
On Error GoTo codeErr

If Not wbSource Is Nothing Then
    '---> 源工作簿已打开，直接引用数据
    Set sourceSheet = wbSource.Sheets(SHEET_NAME)
    Set sourceRange = sourceSheet.Range(SOURCE_RANGE)
    rTarget.Value = sourceRange.Value
Else
    '---> 源工作簿未打开，使用路径公式读取
    sPath = "='C:\Users\Me\Documents\MyFolder[" & WB_NAME & "]" & SHEET_NAME & "'!" & SOURCE_RANGE
    rTarget.FormulaArray = sPath
    rTarget.Value = rTarget.Value
End If

codeExit:
   Set wbSource = Nothing
   Set sourceSheet = Nothing
   Set sourceRange = Nothing
   Set rTarget = Nothing
   Exit Sub
codeErr:
   Debug.Print Err.Number & " " & Err.Description
   Resume codeExit
End Sub

关键改动说明 #

• 新增源工作簿状态判断逻辑，避免不必要的路径解析操作
• 源文件打开时直接通过Workbooks对象读取数据，更高效且不会触发对话框
• 提取常量定义，方便后续修改文件名称、工作表或数据范围信息

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