使用VBA保存外部工作簿时如何隐藏文件路径弹窗

我在主工作簿使用VBA从另一个工作簿复制粘贴数据并保存，但保存时会弹出显示目标文件路径的窗口，不想让其他用户看到这个路径，当前使用的VBA代码如下：

Sub RTS()

ThisWorkbook.Activate

Application.DisplayAlerts = False

Application.ScreenUpdating = False

ActiveSheet.Range("A7:D7", "Q7").Select ActiveSheet.Range("A7:D7,Q7").Select Range("Q7").Activate Application.CutCopyMode = False Selection.Copy

on Error Resume Next While cont Err.Clear Dim wb As Workbook Set wb = Workbooks.Open(Filename:="RTS Report.xlsx") Do Until wb.ReadOnly = False wb.Close Application.Wait Now + TimeValue("00:00:01") Set wb = Workbooks.Open(Filename:="RTS Report.xlsx")

Loop

If Err.Number <> 0 Then Application.Wait (Now + TimeValue("0:00:01")) Err.Clear Else cont = False End If

Wend

On Error GoTo 0

Dim She As Worksheet Dim b As Integer ActiveWorkbook.Sheets("Data").Activate

Set She = ActiveWorkbook.ActiveSheet

b = She.Range("A" & Rows.Count).End(xlUp).Row

She.Range("A" & b + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone,

SkipBlanks:=False, Transpose:=False

Cells.Select Cells.EntireColumn.AutoFit

ActiveWorkbook.Save ActiveWorkbook.Close ThisWorkbook.Activate Application.ScreenUpdating = True Application.DisplayAlerts = True

End Sub

核心修复方案 #

• 隐藏路径弹窗的关键：原代码中ActiveWorkbook.Save可能触发路径弹窗，需确保Application.DisplayAlerts = False全程生效，同时优化保存逻辑避免弹窗。
• 精简代码逻辑：移除冗余的Select/Activate操作，直接引用单元格对象更高效稳定；完善只读文件的循环处理逻辑。

修改后的完整代码 #

Sub RTS()
    Dim sourceRng As Range
    Dim targetWb As Workbook
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim cont As Boolean ' 补充原代码缺失的变量声明
    
    ' 初始化环境，关闭弹窗和屏幕刷新
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' 直接复制目标范围，避免冗余选择操作
    Set sourceRng = ThisWorkbook.ActiveSheet.Range("A7:D7,Q7")
    sourceRng.Copy
    
    ' 循环打开目标工作簿，直到获得可编辑权限
    cont = True
    On Error Resume Next
    Do While cont
        Err.Clear
        Set targetWb = Workbooks.Open(Filename:="RTS Report.xlsx")
        If Err.Number = 0 Then
            If Not targetWb.ReadOnly Then
                cont = False
            Else
                targetWb.Close
                Application.Wait Now + TimeValue("00:00:01")
            End If
        Else
            Application.Wait Now + TimeValue("00:00:01")
        End If
    Loop
    On Error GoTo 0
    
    ' 粘贴数据到目标工作表
    Set targetWs = targetWb.Sheets("Data")
    lastRow = targetWs.Range("A" & targetWs.Rows.Count).End(xlUp).Row
    targetWs.Range("A" & lastRow + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' 调整列宽并静默保存
    targetWs.Cells.EntireColumn.AutoFit
    ' 若文件是首次保存，替换为：targetWb.SaveAs "你的完整文件路径", FileFormat:=xlOpenXMLWorkbook
    targetWb.Save
    targetWb.Close
    
    ' 恢复系统设置
    ThisWorkbook.Activate
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键说明 #

1. 静默保存逻辑：如果RTS Report.xlsx已存在且路径固定，targetWb.Save不会弹出路径窗口；若是新创建的文件，需用SaveAs指定完整路径，因Application.DisplayAlerts = False，不会弹出确认弹窗。
2. 移除冗余操作：原代码中多次Select/Activate不仅低效，还容易引发错误，直接引用单元格对象更稳定。
3. 变量声明：补充了原代码缺失的cont变量，避免隐式变量导致的未知问题。

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