Doc批量转成Docx
在工作中遇到需要将word文档中的doc转换成docx的需求,一共有大几百个文件,这种就不太可能一个个去转换了,文件太多效率太低了。
VBA环境
经过一顿查找之后确定使用Office的VBA(Microsoft Visual Basic for Applications)去做相应转换,它是Office自带的,一般不需要额外安装,转换之后兼容性也比较好。VBA环境开启步骤:
- 打开任意一个word文档,Office版本
- 按下
Alt+F11
快捷键即可看到VBA的编译环境
语法
这里需要一定的编程功底,如果不熟悉VBA的语法,需要一边学习、一边实现业务功能,下面给出相关资料:
转换程序
弹窗选择源路径
运行脚本,通过弹窗选择需要转换文件的根路径:
Sub ConvertDocToDocx()
'Updated by ExtendOffice 20181128
Dim xDlg As FileDialog
Dim xFolder As Variant
Dim xFileName As String
Application.ScreenUpdating = False
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show <> -1 Then Exit Sub
xFolder = xDlg.SelectedItems(1) + "\"
xFileName = Dir(xFolder & "*.doc", vbNormal)
While xFileName <> ""
Documents.Open FileName:=xFolder & xFileName, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.SaveAs xFolder & Replace(xFileName, "doc", "docx"), wdFormatDocumentDefault
ActiveDocument.Close
xFileName = Dir()
Wend
Application.ScreenUpdating = True
End Sub
存在的问题:
- 生成的docx文件与原有的doc文件混在一起
- 生成的第一个docx还被再次被执行一次转换,逻辑上存在bug
完整脚本
实现了一下的几个功能,在此之前需要添加引用:Microsoft Scripting Runtime
- 生成的docx与原有的doc分开,存在一个同级的文件夹中
- 实现了文件夹的循环遍历,根目录下的所有doc都会被找出来执行转换
Attribute VB_Name = "模块2"
Sub main()
Dim fso As New FileSystemObject '定义一个文件系统对象
Dim fld As Folder
Dim xDlg As FileDialog
Dim xDirNam As String
Application.ScreenUpdating = False
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show <> -1 Then Exit Sub
xDirName = xDlg.SelectedItems(1)
If fso.FolderExists(xDirName) Then '判断文件是否存在
Set fld = fso.GetFolder(xDirName)
ScanDirs fld '调用函数
Else
MsgBox "文件夹不存在"
End If
MsgBox "转换完成"
Application.ScreenUpdating = True
End Sub
Sub ScanDirs(fld As Folder)
'递归遍历文件夹
Dim fil As File, outFld As Folder '定义一个文件夹和文件变量
Set subfiles = fld.Files() '获取文件夹下所有文件
Set SubFolders = fld.SubFolders '获取文件夹下所有文件夹
ConvertDocToDocx fld.Path '检查根目录是否有需要转换的
For Each outFld In SubFolders '遍历文件夹
ConvertDocToDocx outFld.Path
ScanDirs outFld '调用函数自身
Next
End Sub
Sub ConvertDocToDocx(xDirName As String)
'doc转换成docx
Dim xFolder As Variant
Dim xSaveFolder As Variant
Dim xFileName As String
xFolder = xDirName + "\"
xSaveFolder = xDirName + "_docx\"
If Dir(xFolder) <> "" And Dir(xSaveFolder) = "" Then MkDir xSaveFolder '判断文件夹是否存在,不存在则创建。
xFileName = Dir(xFolder & "*.doc", vbNormal)
While xFileName <> ""
Documents.Open FileName:=xFolder & xFileName, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.SaveAs xSaveFolder & Replace(xFileName, "doc", "docx"), wdFormatDocumentDefault
ActiveDocument.Close
xFileName = Dir()
Wend
End Sub
Word转换脚本(Doc批量转Docx),可以直接导入这个脚本运行,无需复制黏贴了。
一次选中单个、多个指定的doc文件转换
Attribute VB_Name = "模块5"
Sub doc2docx() 'doc文件转docx文件
Dim myDialog As FileDialog, oFile As Variant
Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
With myDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD97-2003 文件", "*.doc", 1 '增加筛选器的项目为所有WORD97-2003文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
For Each oFile In .SelectedItems '在所有选取项目中循环
With Documents.Open(oFile)
.SaveAs FileName:=Replace(oFile, "doc", "docx"), FileFormat:=12
.Close
End With
Next
End If
End With
End Sub
Word转换脚本(Doc可多选),可以直接导入这个脚本运行,无需复制黏贴了。
后记
VBA还支持转txt、pdf、xls等不同类型文件的读取、解析等一些列操作,这些需要对VBA比较熟悉。
参考资料:
- 如何批量doc/ppt/xls转docx/pptx/xlsx?
- VBA遍历指定文件夹的所有文件(包括子目录)
- 批量将doc转为docx,只能多选doc文件,无法已文件夹为单位去选择。
- 批量将doc转为docx,可以选中多个doc文件执行转换操作。