VBA批量转换 docx转pdf,doc,rtf,txt以及doc转docx.docm
- 格式：doc
- 大小：2.42 MB
- 文档页数：10
VBA批量转换:docx转pdf,doc,rtf,txt以及doc转docx
有时候需要把大量的docx文件另存为其它格式,比如pdf、doc、rtf、txt,或者将doc升级为docx，用VBA可以批量处理。启动word，按下Alt+F11，打开Microsoft Visual Basic for Applications,点击插入>模块，将下面的代码粘贴进去，然后按F5(某些笔记本电脑可能需要按Fn+F5)，或者点击图中的绿色小三角形，便可以执行代码。代码中涉及到的路径要根据自己的实际情况进行修改，有些子文件夹还需要手动创建。pdf文件除了能保持复杂的排版和数学公式不走样，还可以再借助Adobe Acrobat(不是Adobe Reader)另存为png、jpg等图片格式(pdf文件的每一页会成为一张单独的图片)。因为word本身不能直接另存为图片，所以需要借助pdf中转。下面的代码中用到了open函数，并且为名为Visible的参数赋值为msoFalse(msoFalse前面共有11个英文逗号)，目的是打开文件时不在word窗口中显示文件的内容，加快转换速度。尝试过使用Application.ScreenUpdating = False来实现与Visible=msoFalse相同的效果，然而并不可行，不知是什么原因。Replace的作用是修改后缀名，SaveAs2的作用是“另存为”。
'docx转pdf
Option Explicit
Sub docx2pdf()
Dim sEveryFile As String
Dim sSourcePath As String
Dim sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOCX文件\"
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
sNewSavePath = VBA.Strings.Replace(sSourcePath & "PDF文件\" & sEveryFile, ".docx",
".pdf") CurDoc.SaveAs2 sNewSavePath, wdFormatPDF 'CurDoc.ExportAsFixedFormat sNewSavePath, wdExportFormatPDF
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
'docx转doc
Option Explicit
Sub docx2doc()
Dim sEveryFile As String
Dim sSourcePath As String
Dim sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOCX文件\"
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
sNewSavePath = VBA.Strings.Replace(sSourcePath & "DOC文件\" & sEveryFile, ".docx",
".doc")
CurDoc.SaveAs2 sNewSavePath, wdFormatDocument
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
'docx转rtf
Option Explicit
Sub docx2rtf()
Dim sEveryFile As String
Dim sSourcePath As String
Dim sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOCX文件\"
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
sNewSavePath = VBA.Strings.Replace(sSourcePath & "RTF文件\" & sEveryFile, ".docx",
".rtf")
CurDoc.SaveAs2 sNewSavePath, wdFormatRTF
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
'docx转txt
Option Explicit Sub docx2txt()
Dim sEveryFile As String
Dim sSourcePath As String
Dim sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOCX文件\"
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
sNewSavePath = VBA.Strings.Replace(sSourcePath & "TXT文件\" & sEveryFile, ".docx",
".txt")
CurDoc.SaveAs2 sNewSavePath, wdFormatText
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
'doc转docx
Option Explicit
Sub doc2docx()
Dim sEveryFile As String
Dim sSourcePath As String
Dim sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "E:\DOC文件\"
sEveryFile = Dir(sSourcePath & "*.doc")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
CurDoc.Convert
sNewSavePath = VBA.Strings.Replace(sSourcePath & "DOCX文件\" & sEveryFile, ".doc",
".docx")
CurDoc.SaveAs2 sNewSavePath, wdFormatDocumentDefault
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
以下内容为一些函数的介绍。
写这篇文章的另一个目的是证明百度文库的一个文件上传漏洞，这份文档真实的后缀是docm，包含VBA代码，虽然百度文库允许上传的格式是doc,docx,ppt,pptx,xls,xlsx,vsd,pot,pps,rtf,wps,et,dps,
pdf,txt,epub，但是百度文库也只是检查后缀而已，没有对文件的真实内容做检查。只要把docm直接改为doc，即可成功上传。而且可以在网页上正常浏览，下载到本地后也能正常打开。但是不能把docm改为docx，这样改就打不开了，word会提示内容有问题。
xlsm,pptm也可以改为xls和ppt，便能成功上传。要解决这个漏洞也很简单，只要把doc,ppt和xls全部按照zip格式进行解析，查找其中是否存在名为vbaProject.bin文件，如果存在，直接禁止上传，让用户自己删去其中的VBA代码再重新上传。
再看看百度安全应急响应中心对这个问题怎么回复的
这TM真是AI，ArtificialIdiot，人工智障。网盘允许上传任意格式的文件，网盘和文库能相提并论？
所以你觉得百度杀毒能保护你的安全吗？
