除本人外所有用户第二次调用ThisWorkbook.SaveAs失败问题咨询

问题根因 #

你本地可正常运行并非是Excel存在特殊全局设置，核心是你的环境提前满足了运行条件，其他用户触发报错的常见原因如下：

• 归档目录不存在：SaveAs方法不会自动创建父级目录，如果你本地提前手动创建了Archive子文件夹，其他用户环境中该目录未创建，执行归档保存时就会直接报错
• 格式与后缀不匹配：代码中指定的保存格式xlOpenXMLWorkbook对应无宏的.xlsx格式，但你给出的路径示例后缀为.xls，你的Excel大概率开启了「忽略文件扩展名与格式不匹配的警告」的设置，其他用户未开启该设置时，格式校验不通过就会触发保存失败
• 权限/文件占用问题：其他用户可能没有Archive子目录的写入权限，或归档路径下存在同名文件且被其他程序占用，也会触发该报错
• 工作簿状态错位：第一次执行SaveAs后，当前打开的工作簿已经变为新保存的file_full，如果arch_full的路径生成逻辑依赖原工作簿的路径属性，就会出现路径拼接错误，进一步导致保存失败

兼容性多副本保存方案 #

优先使用SaveCopyAs方法生成副本，该方法不会改变当前打开的工作簿的状态，避免多次SaveAs导致的工作簿身份错位问题，修复后的参考代码如下：

' 晚绑定文件系统对象，无需提前引用库，兼容性更强
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

' -------------------------- 保存常规副本 --------------------------
' 校验常规副本路径是否存在，不存在则创建
Dim file_dir As String
file_dir = fso.GetParentFolderName(file_full)
If Not fso.FolderExists(file_dir) Then
    fso.CreateFolder file_dir
End If
' 保存副本
ThisWorkbook.SaveCopyAs Filename:=file_full

' -------------------------- 保存归档副本 --------------------------
' 校验归档目录是否存在，不存在则自动创建
Dim arch_dir As String
arch_dir = fso.GetParentFolderName(arch_full)
If Not fso.FolderExists(arch_dir) Then
    fso.CreateFolder arch_dir
End If
' 校验归档文件是否被占用
If fso.FileExists(arch_full) Then
    On Error Resume Next
    Open arch_full For Binary Access Read Write Lock Read Write As #1
    Close #1
    If Err.Number <> 0 Then
        MsgBox "归档文件已被其他程序占用，请关闭后重试", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
End If
' 保存归档副本
ThisWorkbook.SaveCopyAs Filename:=arch_full

Set fso = Nothing

额外适配注意事项 #

• 统一文件格式与后缀对应关系：如果需要保存无宏版本，xlOpenXMLWorkbook格式对应后缀必须为.xlsx；如果需要保留宏代码，使用xlOpenXMLWorkbookMacroEnabled格式对应.xlsm后缀；如果必须兼容旧版.xls格式，将格式参数改为xlExcel8，避免格式校验报错
• 如果需要强制剥离宏保存为无宏版本，不要连续调用两次SaveAs，第一次保存后重新打开原宏文件再执行第二次保存，避免工作簿状态错位
• 确保所有操作用户都拥有Archive子目录的读写权限

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