開源批次轉換Word文件到PDF
新入手了個Kindle，閱讀起來比液晶顯示屏舒服多了，然而我的資料文件有點多，Kindle要閱讀doc檔案只能透過郵箱推送，檔案大小也有限制，而且很多文件不適合弄到郵箱裡發來發去（你懂的），有的文件內還有很多數學公式圖片等等，要確保轉換前和轉換後文檔排版、內容一致，PDF便是一個比較好的選擇（如果你有更好選擇請留言）。
在網上一搜
批次Word2PDF
，Windows下一堆工具可用，但一弄下來要麼格式不對或者字型丟失，要麼付費，索性一咬牙自己寫個。
首先分析需求，我們要的是一個
批次轉換工具
，
畢竟單檔案轉換的話直接用Word開啟另存為就可以啦~（笑）
，難是難在一個資料夾底下幾千個Word文件都要變成PDF格式，若是一個個去開啟另存為。。因此，我們需要先遞迴遍歷工作資料夾，得到該資料夾及其子資料夾底下所有的Word文件並將檔案列表儲存到目錄下的ConvertFileList。txt檔案中，之後交給使用者編輯轉換列表，增刪要轉換的檔案條目，之後再交給轉換程式處理。Word和WPS裡都有另存為PDF選項，而這兩個軟體一般在用電腦看doc文件的人的機器上大概都有安裝（線上閱覽的不算），因此決定透過com來呼叫Word或WPS作為Word文件轉PDF的轉換程式，而為了使用以及未來修改除錯方便，因此程式語言我選擇了VBScript。為了方便檢視進度，我們還可以新增一個LogOut函式，因此，程式碼如下：
Dim fso，fld，Path
Set fso = WScript。CreateObject（“Scripting。Filesystemobject”）
Path = fso。GetParentFolderName（WScript。ScriptFullName） ‘獲取指令碼所在資料夾字串
Set fld=fso。GetFolder（Path） ’透過路徑字串獲取資料夾物件
Dim Sum，IsChooseDelete，ThisTime
Sum = 0
Dim LogFile
Set LogFile= fso。opentextFile（“log。txt”，8，true）
Dim List
Set List= fso。opentextFile（“ConvertFileList。txt”，2，true）
Call LogOut（“開始遍歷檔案”）
Call TreatSubFolder（fld） ‘呼叫該過程進行遞迴遍歷該資料夾物件下的所有檔案物件及子資料夾物件
Sub LogOut（msg）
ThisTime=Now
LogFile。WriteLine（year（ThisTime） & “-” & Month（ThisTime） & “-” & day（ThisTime） & “ ” & Hour（ThisTime） & “：” & Minute（ThisTime） & “：” & Second（ThisTime） & “： ” & msg）
End Sub
Sub TreatSubFolder（fld）
Dim File
Dim ts
For Each File In fld。Files ’遍歷該資料夾物件下的所有檔案物件
If UCase（fso。GetExtensionName（File）） =“DOC” or UCase（fso。GetExtensionName（File）） =“DOCX” Then
List。WriteLine（File。Path）
Sum = Sum + 1
End If
Next
Dim subfld
For Each subfld In fld。SubFolders ‘遞迴遍歷子資料夾物件
TreatSubFolder subfld
Next
End Sub
List。close
Call LogOut（“檔案遍歷已完成，已找到” & Sum & “個word文件”）
若是使用者修改了檔案列表，則需要過載ConvertFileList。txt，跳過Word的臨時檔案並重新統計總任務數，程式碼如下：
Sum = 0
Dim FilePath，FileLine
Set List= fso。opentextFile（“ConvertFileList。txt”，1，true）
Do While List。AtEndOfLine <> True
FileLine=List。ReadLine
If FileLine <> “” and Mid（FileLine，1，2） <> “~$” Then
Sum = Sum + 1 ’獲取使用者修改後的檔案列表行數
End If
loop
List。close
轉換文件需要呼叫WordAPP，程式碼如下：
‘建立Word物件，相容WPS
Const wdFormatPDF = 17
On Error Resume Next
Set WordApp = CreateObject（“Word。Application”）
’ try to connect to wps
If WordApp Is Nothing Then ‘相容WPS
Set WordApp = CreateObject（“WPS。Application”）
If WordApp Is Nothing Then
Set WordApp = CreateObject（“KWPS。Application”）
If WordApp Is Nothing Then
MsgBox “本程式依賴office 2010及以上版本，相容WPS，” & vbCrlf & “請在使用本程式前安裝office word 或WPS，否則本程式無法使用”， vbCritical + vbOKOnly， “無法轉換”
WScript。Quit
End If
End If
End If
On Error Goto 0
我們希望程式在後臺執行，因此：
WordApp。Visible=false ’設定檢視不可見
之後開始轉換過程：
Dim Finished
Finished = 0
Set List= fso。opentextFile（“ConvertFileList。txt”，1，true）
Do While List。AtEndOfLine <> True
FilePath=List。ReadLine
If Mid（FilePath，1，2） <> “~$” Then ‘不處理word臨時檔案
Set objDoc = WordApp。Documents。Open（FilePath）
If WordApp。Visible = true Then
WordApp。ActiveDocument。ActiveWindow。WindowState = 2 ’wdWindowStateMinimize
End If
objDoc。SaveAs Left（FilePath，InstrRev（FilePath，“。”）） & “pdf”， wdFormatPDF ‘另存為PDF文件
LogOut（“文件” & FilePath & “已轉換完成。（” & Finished & “/” & Sum & “）”）
WordApp。ActiveDocument。Close
Finished = Finished + 1
End If
If IsChooseDelete = vbYes Then
fso。deleteFile FilePath
LogOut（“檔案” & FilePath & “已被成功刪除”）
End If
loop
’掃尾處理，ConvertFileList。txt和log。txt要自動刪除的請去掉下面兩行開頭單引號
‘fso。deleteFile “ConvertFileList。txt”
’fso。deleteFile “log。txt”
List。close
LogOut（“文件轉換已完成”）
LogFile。close
Dim Msg
Msg = “已成功轉換” & Finished & “個檔案”
If IsChooseDelete = vbYes Then
Msg=Msg + “併成功刪除原始檔”
End If
MsgBox Msg & vbCrlf & “日誌檔案在” & fso。GetFolder（Path）。Path & “\log。txt”
Set fso = nothing
WordApp。Quit
Wscript。Quit
就這樣，一個市面上普遍售價兩百餘元的批次轉換DOC到PDF的程式就完成了，目前效果不錯，577個DOC檔案轉換出來用時26分鐘，因為沒有用到多執行緒，所以CPU和硬碟都沒跑滿，有興趣提高效能或者增刪功能的可以自己改改，
完整程式碼在GitHub：
https：//
github。com/cxgreat2014/
VBScript_DOC2PDF
若有BUG請在GitHub開Issues或者在知乎留言聯絡我，thx
