Word自定义另存为按钮遇权限错误求助（附VBA代码）

错误核心原因及修复方案 #

1. 清理单元格文本中的非法字符并合并双单元格内容 #

Word表格单元格的Range.Text会默认包含单元格结束标记（Chr(13)+Chr(7)），这类字符属于Windows文件名禁用字符，直接用作文件名会触发保存失败。同时你需求是用两个单元格内容命名，当前代码仅读取了单个单元格，需补充并清理文本：

修改文件名获取逻辑，新增非法字符清理函数：

' 获取两个目标单元格内容（根据实际表格位置调整Cell的行/列参数）
Dim cellText1 As String, cellText2 As String
cellText1 = ActiveDocument.Tables(1).Cell(1, 2).Range.Text
cellText2 = ActiveDocument.Tables(1).Cell(1, 3).Range.Text

' 清理非法字符并合并内容（用下划线分隔，可自定义分隔符）
filename1 = CleanFilename(cellText1 & "_" & cellText2)

添加辅助清理函数：

Function CleanFilename(strName As String) As String
    Dim illegalChars As Variant, i As Integer
    ' Windows文件名禁用字符列表
    illegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|", Chr(13), Chr(7))
    
    ' 遍历移除所有非法字符
    For i = LBound(illegalChars) To UBound(illegalChars)
        strName = Replace(strName, illegalChars(i), "")
    Next i
    
    ' 去除首尾空格
    CleanFilename = Trim(strName)
End Function

2. 确保目标路径存在 #

如果C:\Users\TECHTOOL\Desktop\Ongoing\文件夹未创建，Word会误报权限错误。添加路径检查与自动创建逻辑：

path = "C:\Users\TECHTOOL\Desktop\Ongoing\"
' 检查路径是否存在，不存在则创建
If Dir(path, vbDirectory) = "" Then
    MkDir path
End If

3. 避免修改原模板文档 #

如果原文档是模板文件（.dotm），直接使用SaveAs会修改模板本身，应改用SaveAs2另存为独立文档，保留原模板的模板属性：

' 根据文档类型选择保存方式，保护原模板
If ActiveDocument.Type = wdTypeTemplate Then
    ActiveDocument.SaveAs2 filename:=path & filename1 & ".docm", FileFormat:=wdFormatFlatXMLMacroEnabled
Else
    ActiveDocument.SaveAsCopy filename:=path & filename1 & ".docm"
End If

4. 验证文件夹权限 #

若以上步骤仍报错，需确认目标文件夹权限：

• 右键Ongoing文件夹 → 属性 → 取消勾选“只读”（应用到所有文件和子文件夹）
• 右键文件夹 → 属性 → 安全 → 确认当前用户拥有“写入”权限

完整修正代码 #

Private Sub CommandButton1_Click()
    Dim path As String
    Dim filename1 As String
    Dim cellText1 As String, cellText2 As String
    
    ' 设置目标保存路径
    path = "C:\Users\TECHTOOL\Desktop\Ongoing\"
    
    ' 检查并自动创建路径
    If Dir(path, vbDirectory) = "" Then
        MkDir path
    End If
    
    ' 获取两个单元格内容（自行调整Cell的行号、列号）
    cellText1 = ActiveDocument.Tables(1).Cell(1, 2).Range.Text
    cellText2 = ActiveDocument.Tables(1).Cell(1, 3).Range.Text
    
    ' 清理文件名并合并双单元格内容
    filename1 = CleanFilename(cellText1 & "_" & cellText2)
    
    ' 禁用保存提示弹窗
    Application.DisplayAlerts = wdAlertsNone
    
    ' 按文档类型保存，保护原模板/文档
    If ActiveDocument.Type = wdTypeTemplate Then
        ActiveDocument.SaveAs2 filename:=path & filename1 & ".docm", FileFormat:=wdFormatFlatXMLMacroEnabled
    Else
        ActiveDocument.SaveAsCopy filename:=path & filename1 & ".docm"
    End If
    
    ' 恢复弹窗提示
    Application.DisplayAlerts = wdAlertsAll
    
    ' 关闭当前编辑的文档（若需保留原模板打开状态，可删除此行）
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub

' 清理文件名非法字符的辅助函数
Function CleanFilename(strName As String) As String
    Dim illegalChars As Variant, i As Integer
    illegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|", Chr(13), Chr(7))
    
    For i = LBound(illegalChars) To UBound(illegalChars)
        strName = Replace(strName, illegalChars(i), "")
    Next i
    
    CleanFilename = Trim(strName)
End Function

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