Word VBA宏二次运行标题空白、多次保存报错问题求助

故障根因说明 #

• 故障1（第二次运行选「否」标题空白）：非首次运行的逻辑分支中，用户选择不修改标题时未对Title变量做任何赋值，既没有读取已有文件名中的旧标题，也没有赋值默认值，导致拼接保存路径时Title字段为空
• 故障2（第三次运行报错）：
  1. 变量currentVersion全程未赋值，版本升级时执行newVersion = currentVersion + 1会触发空值运算错误
  2. 错误将MsgBox的返回值（vbYes/vbNo枚举值）直接赋值给数值类型的Version变量，触发类型不匹配错误
  3. 首次拆分已有文件名时仅提取了用户和版本字段，未提取已有标题，导致后续非首次运行时无旧标题可复用

修复后完整代码 #

Private Sub CommandButton3_Click()
   
    Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
    Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
    Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
    Dim Title As String
    Dim oriTitle As String: oriTitle = "Besprechungsnotizen"
    Dim newTitleMsg As VbMsgBoxResult
    Dim currentTitle As String
    Dim User As String
    Dim currentUser As String
    Dim Version As Integer
    Dim newVersionMsg As VbMsgBoxResult
    Dim currentVersion As Integer
    Dim nameElements As Variant
    Dim i As Integer

    If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
        ' 首次保存，无历史保存记录
        User = ""
        Version = 0
    Else
        ' 非首次保存，从已有文件名提取历史信息
        nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
        ' 提取用户
        User = nameElements(UBound(nameElements))
        ' 提取版本号（去掉前缀0）
        currentVersion = CInt(Right(nameElements(UBound(nameElements) - 1), Len(nameElements(UBound(nameElements) - 1)) - 1)
        Version = currentVersion
        ' 提取已有标题
        Title = ""
        For i = 1 To UBound(nameElements) - 3
            If Title <> "" Then Title = Title & "_"
            Title = Title & nameElements(i)
        Next
    End If

    If User = "" Then
        ' 首次保存逻辑
        User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
        newTitleMsg = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
        If newTitleMsg = vbYes Then
            Title = InputBox("Wie soll der Titel sein?")
        Else
            Title = oriTitle
        End If
        Version = 0
    Else
        ' 非首次保存逻辑
        currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
        If currentUser <> User Then
            User = User & "_" & currentUser
        End If
        ' 处理标题修改
        newTitleMsg = MsgBox("Neuer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
        If newTitleMsg = vbYes Then
            Title = InputBox("Wie soll der neue Titel sein?")
        End If
        ' 处理版本升级
        newVersionMsg = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Version")
        If newVersionMsg = vbYes Then
            Version = currentVersion + 1
        Else
            Version = currentVersion
        End If
    End If
    
    ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & CStr(Version) & "_" & User

End Sub

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