如何用VBA阻止含敏感数据的Excel工作簿保存至OneDrive？

问题概述 #

基于模板创建的启用宏Excel工作簿，模板本身无敏感数据；用户完成身份验证后，会从远程服务器加载敏感数据。核心需求是禁止该工作簿保存到任何位置，所有数据仅通过VBA与服务器交互完成存储。当前Workbook_BeforeSave事件可拦截本地保存操作，但Office 365用户开启自动保存（Autosave）时，工作簿会被自动同步至OneDrive，现有代码无法拦截；事后检查路径并清除敏感数据的方案无效，因为OneDrive的版本历史会留存原始保存文件。

针对性解决建议 #

1. 启动时强制关闭Autosave并禁用保存相关UI #

不能仅在保存事件中关闭Autosave，需在工作簿打开阶段就强制关闭，并禁用所有保存相关的UI元素和快捷键：

Private Sub Workbook_Open()
    ' 强制关闭自动保存
    ThisWorkbook.AutoSaveOn = False
    ' 禁用所有保存相关操作入口
    DisableSaveControls
End Sub

Private Sub DisableSaveControls()
    ' 禁用菜单栏、工具栏的保存按钮
    Application.CommandBars("File").Controls("Save").Enabled = False
    Application.CommandBars("File").Controls("Save As").Enabled = False
    Application.CommandBars("Standard").Controls("Save").Enabled = False
    ' 禁用Ctrl+S快捷键
    Application.OnKey "^s", ""
End Sub

补充：若要彻底隐藏Backstage中的自动保存开关，需添加Ribbon自定义XML，将对应选项设为不可见。

2. 实时监控工作簿路径，发现云端保存立即清除数据 #

通过工作表变更事件或定时检查，实时检测工作簿是否被保存至OneDrive/SharePoint，一旦发现立即清除敏感数据并关闭工作簿：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    CheckCloudSaveStatus
End Sub

Private Sub CheckCloudSaveStatus()
    Dim wbFullPath As String
    wbFullPath = ThisWorkbook.FullName
    
    ' 判断是否为云端路径（OneDrive/SharePoint）
    If InStr(wbFullPath, "https://") > 0 Or InStr(wbFullPath, "OneDrive") > 0 Then
        ClearAllSensitiveData
        MsgBox "禁止将含敏感数据的工作簿保存至云端，已清除数据并将关闭。", vbCritical
        ThisWorkbook.Close SaveChanges:=False
    End If
End Sub

Private Sub ClearAllSensitiveData()
    ' 根据实际敏感数据所在区域调整，示例清除所有工作表内容
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Cells.ClearContents
    Next ws
End Sub

注：虽然OneDrive版本历史仍会留存原始文件，但此操作能最快清除当前可见的敏感数据，降低泄露风险。

3. 设置工作簿为只读模式 #

从打开环节限制保存可能性，强制工作簿以只读模式打开：

Private Sub Workbook_Open()
    ThisWorkbook.ReadOnly = True
End Sub

配合UI禁用方案，可大幅降低用户手动保存的概率，但无法完全阻止"另存为"操作，需与其他方案结合使用。

4. 优化现有BeforeSave事件代码 #

修正原代码逻辑，确保Autosave被彻底关闭，同时明确保存提示：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ' 强制关闭自动保存
    ThisWorkbook.AutoSaveOn = False
    Cancel = True ' 拦截所有保存请求
    
    frmMessage.lbllMessage.Caption = "正在将数据同步至服务器..."
    frmMessage.Show vbModeless
    
    ' 与Office.js插件交互完成服务器端保存
    message_to_addin "save"
    Application.OnTime DateAdd("s", 1, Now), "read_message_from_addin"
End Sub

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