如何用VBA捕获/读取执行时弹出的磁盘空间不足对话框？

一、先解决共享驱动器空间检查失效问题（从根源避免弹窗） #

VBA自带的FileSystemObject对共享路径的空间检查容易受权限限制失效，改用Windows API直接读取系统级磁盘信息即可解决：

Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
    (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, _
    lpTotalNumberOfBytes As Currency, _
    lpTotalNumberOfFreeBytes As Currency) As Boolean

Function GetFreeSpaceUNC(UNCPath As String) As Double
    Dim freeBytes As Currency, totalBytes As Currency, freeTotal As Currency
    Dim success As Boolean
    
    ' API要求路径以反斜杠结尾，自动补全
    If Right(UNCPath, 1) <> "\" Then UNCPath = UNCPath & "\"
    
    success = GetDiskFreeSpaceEx(UNCPath, freeBytes, totalBytes, freeTotal)
    
    If success Then
        ' 转换为MB单位（1MB=1048576字节）
        GetFreeSpaceUNC = CCur(freeBytes) / 1048576
    Else
        GetFreeSpaceUNC = -1 ' 返回-1表示检查失败
    End If
End Function

' 调用示例：保存前检查共享盘空间
Sub SaveWithSpaceCheck()
    Dim targetPath As String
    targetPath = "\\server\shared\save_folder" ' 替换为你的共享路径
    Dim freeMB As Double
    
    freeMB = GetFreeSpaceUNC(targetPath)
    If freeMB = -1 Then
        ' 空间检查失败时的处理逻辑
        Debug.Print "无法获取共享盘空间信息"
        Exit Sub
    End If
    
    ' 设置空间阈值（比如低于100MB时阻止保存）
    If freeMB < 100 Then
        Debug.Print "磁盘空间不足，无法执行保存"
        ' 可在此添加通知Automation Anywhere机器人的逻辑
        Exit Sub
    End If
    
    ' 空间充足，执行保存
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs targetPath & "\filename.xlsm"
    Application.DisplayAlerts = True
End Sub

二、捕获并关闭系统级"磁盘空间不足"弹窗 #

这个弹窗是Windows系统触发的，不属于VBA运行时错误，因此On Error和Application.DisplayAlerts都无法拦截，需用Windows API监控并关闭：

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_CLOSE = &H10

' 后台监控并关闭磁盘空间弹窗
Sub MonitorAndCloseLowSpaceAlert()
    Dim hwnd As LongPtr
    Do
        ' 查找标题为"磁盘空间不足"的窗口（英文系统需改为"Low Disk Space"）
        hwnd = FindWindow(vbNullString, "磁盘空间不足")
        If hwnd <> 0 Then
            SendMessage hwnd, WM_CLOSE, 0, 0 ' 关闭弹窗
            Debug.Print "已关闭磁盘空间不足弹窗"
            Exit Do ' 关闭后退出循环，如需持续监控可移除该行
        End If
        Sleep 500 ' 每500毫秒检查一次，避免占用过多资源
    Loop
End Sub

使用说明：

• 可在保存操作前用Application.OnTime异步启动监控，避免阻塞主流程
• 需根据系统语言调整窗口标题，确保能精准匹配

三、结合Automation Anywhere的优化方案 #

既然由机器人执行，可在VBA之外补充处理：

• 用AA自带的「检查磁盘空间」动作直接校验共享路径，该动作对网络共享盘的支持更稳定
• 在AA工作流中配置「窗口监控」动作，实时捕获"磁盘空间不足"弹窗并执行关闭操作，比VBA监控更可靠

• Application.DisplayAlerts = False仅控制Excel自身的提示（如覆盖文件、格式兼容警告），对系统级弹窗完全无效
• On Error只能捕获VBA代码运行时的错误，系统弹窗不属于这个范畴，因此无法捕获
• 共享路径的空间检查必须依赖系统API，FileSystemObject受网络权限影响较大，容易出现失效情况

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