【Office】【VBA宏】实现多选word文件转换为docx格式

提示：文章写完后，目录可以自动生成，如何生成可参考右边的帮助文档

---

需求概述

---

提示：以下是本篇文章正文内容，下面案例可供参考

实现流程

1. 由于要拆分的数据量可能会比较大考虑性能问题（关闭屏幕更新提高性能）.
2. 要求选择一个文件夹作为拆分后存放文件的路径。
3. 循环遍历每个工作表进行保存。
4. 显示一个消息框来通操作已完成。

具体代码

代码如下（示例）：

Sub MultiSaveAsDocx()
    Dim fd As FileDialog
    Dim filePath As String
    Dim fileName As String
    Dim newFilePath As String
    Dim doc As Document
    Dim allFilesConverted As Boolean
    allFilesConverted = True ' 假设所有文件都能成功转换
      
    ' 创建一个文件选择对话框
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
      
    With fd
        .Title = "请选择要转换的Word文件（可多选）"
        .Filters.Clear
        .Filters.Add "Word Files", "*.doc; *.docx; *.dot; *.dotx; *.rtf"
        .AllowMultiSelect = True ' 允许多选
          
        ' 显示对话框
        If .Show = -1 Then
            ' 遍历选中的所有文件
            Dim i As Long
            For i = 1 To .SelectedItems.Count
                filePath = .SelectedItems(i)
                fileName = GetFileNameWithoutExt(filePath) ' 获取不带扩展名的文件名
                  
                ' 构建新的文件路径（假设与原始文件在同一目录下）
                newFilePath = Replace(filePath, GetFileExtension(filePath), "docx")
                  
                ' 打开文档
                Set doc = Documents.Open(filePath)
                  
                ' 尝试另存为.docx格式
                On Error Resume Next ' 捕获并忽略可能出现的错误
                doc.SaveAs2 fileName:=newFilePath, FileFormat:=wdFormatXMLDocument ' wdFormatXMLDocument 是.docx的枚举值
                If Err.Number <> 0 Then
                    allFilesConverted = False ' 如果有文件转换失败，标记为False
                    MsgBox "文件 '" & fileName & "' 转换失败。", vbExclamation
                    Err.Clear ' 清除错误
                End If
                On Error GoTo 0 ' 恢复正常的错误处理
                  
                ' 关闭文档，不保存更改（因为我们刚才已经另存为了.docx）
                doc.Close SaveChanges:=False
                  
                ' 清除对象
                Set doc = Nothing
            Next i
              
            ' 如果所有文件都成功转换，则显示消息
            If allFilesConverted Then
                MsgBox "所有文件已成功转换为.docx格式。", vbInformation
            End If
        End If
    End With
      
    ' 清理
    Set fd = Nothing
End Sub
  
' 获取文件名（不带扩展名）
Function GetFileNameWithoutExt(filePath As String) As String
    Dim pos As Integer
    pos = InStrRev(filePath, ".")
    If pos > 0 Then
        GetFileNameWithoutExt = Left(filePath, pos - 1)
    Else
        GetFileNameWithoutExt = filePath
    End If
End Function
  
' 获取文件扩展名
Function GetFileExtension(filePath As String) As String
    Dim pos As Integer
    pos = InStrRev(filePath, ".")
    If pos > 0 Then
        GetFileExtension = Right(filePath, Len(filePath) - pos)
    Else
        GetFileExtension = ""
    End If
End Function

---

使用方法

1. 打开Excel并加载包含要拆分数据的工作簿。
2. 按Alt + F11打开VBA编辑器。
3. 在项目浏览器中，右键点击你的工作簿名称，选择“插入” -> “模块”。
4. 在新打开的模块窗口中，粘贴上述代码。
5. 按F5运行MultiSaveAsDocx宏。
6. 根据提示框选择要转换的word文件。
7. 等待宏运行完成的提示。
   

注意事项

在运行宏之前，请确保备份你的数据，以防万一出现意外情况。

小结

到此，所有分享结束了，希望代码可以帮助你们。还有更多功能和方法值得我和你们去研究，感谢浏览。有其他好的问题和经验可以在评论区留言或私信我。