如何在Word VBA中正确使用枚举实现RTF转DOCX自动化保存？

核心问题分析 #

你当前的代码通过手动截取.RTF后缀实现格式转换，但存在几个潜在问题：比如文件名长度不足4字符时会报错、文件名包含多个点（如report.v2.rtf）时截取逻辑失效，且依赖ActiveDocument.Name仅能获取文件名，无法灵活指定保存路径。

优化方案 #

1. 安全处理文件名后缀 #

用FileSystemObject的原生方法替代手动字符串截取，更可靠地处理文件名和路径：

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim docFullPath As String
docFullPath = ActiveDocument.FullName

ActiveDocument.SaveAs2 _
    FileName:=fso.BuildPath(fso.GetParentFolderName(docFullPath), _
                            fso.GetBaseName(docFullPath) & ".docx"), _
    FileFormat:=wdFormatXMLDocument ' 直接指定DOCX格式，比wdFormatDocumentDefault更稳定

说明：wdFormatXMLDocument（枚举值12）是Word 2007+的标准DOCX格式，避免wdFormatDocumentDefault在兼容模式下默认保存为DOC格式的风险。

2. 批量处理文件夹内所有RTF文件 #

针对多文件场景，直接遍历指定文件夹批量处理，无需逐个手动打开文档：

Sub BatchConvertRTFtoDOCX()
    Dim fso As Object
    Dim folderPath As String
    Dim targetFile As Object
    Dim currentDoc As Document
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含RTF文件的文件夹"
        If .Show <> -1 Then Exit Sub
        folderPath = .SelectedItems(1)
    End With
    
    ' 关闭屏幕刷新提升效率
    Application.ScreenUpdating = False
    
    ' 遍历RTF文件
    For Each targetFile In fso.GetFolder(folderPath).Files
        If LCase(fso.GetExtensionName(targetFile.Name)) = "rtf" Then
            Set currentDoc = Documents.Open(targetFile.Path)
            
            ' 插入图片大小调整逻辑（示例）
            ' Dim picShape As InlineShape
            ' For Each picShape In currentDoc.InlineShapes
            '     If picShape.Type = wdInlineShapePicture Then
            '         picShape.ScaleHeight = 50 ' 高度缩放50%
            '         picShape.ScaleWidth = 50 ' 宽度缩放50%
            '     End If
            ' Next picShape
            
            ' 保存为DOCX
            currentDoc.SaveAs2 _
                FileName:=fso.BuildPath(folderPath, fso.GetBaseName(targetFile.Name) & ".docx"), _
                FileFormat:=wdFormatXMLDocument
            currentDoc.Close wdDoNotSaveChanges
        End If
    Next targetFile
    
    Application.ScreenUpdating = True
    MsgBox "批量转换完成！"
End Sub

3. 避免依赖ActiveDocument #

尽量不要用ActiveDocument，手动操作时容易误选其他文档，通过Documents.Open返回的文档对象直接操作更安全。

4. 添加错误捕获 #

防止单个文件处理失败导致整个批量任务中断：

Sub BatchConvertRTFtoDOCX()
    Dim fso As Object
    Dim folderPath As String
    Dim targetFile As Object
    Dim currentDoc As Document
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含RTF文件的文件夹"
        If .Show <> -1 Then Exit Sub
        folderPath = .SelectedItems(1)
    End With
    
    Application.ScreenUpdating = False
    
    For Each targetFile In fso.GetFolder(folderPath).Files
        If LCase(fso.GetExtensionName(targetFile.Name)) = "rtf" Then
            On Error Resume Next ' 开启错误捕获
            Set currentDoc = Documents.Open(targetFile.Path)
            If Err.Number = 0 Then
                ' 图片调整逻辑...
                
                currentDoc.SaveAs2 _
                    FileName:=fso.BuildPath(folderPath, fso.GetBaseName(targetFile.Name) & ".docx"), _
                    FileFormat:=wdFormatXMLDocument
                currentDoc.Close wdDoNotSaveChanges
            Else
                ' 错误日志输出到调试窗口
                Debug.Print "处理失败：" & targetFile.Path & " | 错误信息：" & Err.Description
                Err.Clear
            End If
            On Error GoTo 0 ' 恢复默认错误处理
        End If
    Next targetFile
    
    Application.ScreenUpdating = True
    MsgBox "批量转换完成！"
End Sub

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