VBS word/excel 轉 PDF

同事問有沒有批量把word和excel 轉PDF的工具，要在原目錄下生成pdf，網上應該有很多這類工具。自己想做個小工具，先用python，使用win32com，結果有的文檔沒有轉換，問題一堆，最後還是使用最簡單的VBS來實現，缺點沒有界面不知道執行進度。

轉換時，將這個腳本放在包含word/excel的根目錄下，雙擊運行就可以了。

wsToPdf.vbs

dim ObjFSO,currentDir
dim fileCount,word_count,excel_count,delCount,logfile
filecCount = 0
word_count = 0
excel_count = 0
delCount = 0

Set ObjWS = WScript.CreateObject("wscript.shell")
currentDir = ObjWS.CurrentDirectory
logfile = currentDir & "\log.txt"

Set ObjFSO = CreateObject("Scripting.FileSystemObject") 

'--開始搜索Word\Excel文檔
SearchFolder objFSO,currentDir

data = "清理臨時文件：" & delCount & vbCrLf & "Word 轉 PDF：" & word_count & vbCrLf & "Excel 轉 PDF：" & excel_count
msg = Msgbox(data,0+64+0,"Word/Excel 轉換 PDF")

Set ObjFSO = Nothing
Set ObjWS = Nothing

'--查找目錄
sub SearchFolder(objFSO,folderPath)
    Set ObjFolder = objFSO.GetFolder(folderPath)
    Set SubFolders = ObjFolder.SubFolders
    Set files = ObjFolder.files
    For Each file In files
        ext = lcase(objFSO.GetExtensionName(file))
        
        if ext="doc" or ext="docx" or ext="xls"  or ext="xlsx" Then
            if InStr(file,"~")= 0 Then
                fileCount = fileCount + 1
                src = ObjFolder & "\" & file.name
                if InStr(ext,"do")> 0 Then
                    word_count = word_count + 1
                    msg = WordToPdf(word_count,src)
                else
                    excel_count = excel_count + 1
                    msg = ExcelToPdf(excel_count,src)
                end if
                writeLog objFSO,fileCount, msg
            else
                delCount = delCount + 1
                src = ObjFolder & "\" & file.name
                objFSO.DeleteFile src
                writeLog objFSO,delCount, src & "被刪除"
            end if
        elseIf lcase(ext)="pdf" Then
            'delCount = delCount + 1
            'src = ObjFolder & "\" & file.name
            'objFSO.DeleteFile src
            'writeLog objFSO,delCount, src & "被刪除"
        end if
    Next
    
    For Each subFolder In SubFolders
        SearchFolder objFSO,subFolder.path
    Next
end sub
 
'--word 轉 pdf
function WordToPdf(n,src)
    On Error Resume Next
    wdExportFormatPDF = 17
    if n >0 Then
        Set oWord = WScript.CreateObject("Word.Application")
        Set oDoc = oWord.Documents.Open(src)
        pdf = Left(src,InStrRev(src,".")) & "pdf"
        oDoc.SaveAs pdf,wdExportFormatPDF
        If Err.Number Then
            WordToPdf = src & " 轉換pdf失敗。" & Err.Description
            'MsgBox "err:" & Err.Description
        else
            WordToPdf = src & " 轉換爲pdf完成。"
        End If
        oDoc.Close
        oWord.Quit
    end if
    Set oDoc = Nothing
    Set oWord = Nothing
    On Error Goto 0
end function

'--excel 轉 pdf
function ExcelToPdf(n,src)
    On Error Resume Next
    if n >0 Then
        Set oExcel = WScript.CreateObject("Excel.Application")
        Set oWb = oExcel.Workbooks.Open(src)
        pdf = Left(src,InStrRev(src,".")) & "pdf"
        oExcel.displayalerts=false
        oWb.ExportAsFixedFormat xlTypePDF,pdf,0,1,1,,,0
        oExcel.displayalerts=false '--不出現保存提示框
        If Err.Number Then
            ExcelToPdf = src & " 轉換pdf失敗。" & Err.Description
        else
            ExcelToPdf = src & " 轉換爲pdf完成。"
        End If
        oWb.Close
        oExcel.Quit
    end if
    Set oWb = Nothing
    Set oExcel = Nothing
    On Error Goto 0
end function

'--寫轉換日誌
sub writeLog(fs,n,data)
    data = n & "、" & date() & " " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & "：" & data
    if (fs.FileExists(logfile)) then
        set f =fs.opentextfile(logfile,8)
        f.writeline data
        f.close
    else
        set f=fs.opentextfile(logfile,2,true)
        f.writeline data
        f.close
    end if
    set f = nothing
end sub