The following is a vbscript to convert all .doc and .docx files in the current folder and all its subfolders to pdf files.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
option Explicit 'recursively tranverse the folder and its sub folders'objFSO the file system objects'folder the folder to tranverseSub TranversesubFolders(objFSO, folder) Dim filename Dim outfilename Dim strLen Dim subFolder Dim colFiles Dim objFile Set colFiles = objFolder.Files 'get the collection of files in this folder 'for each .docx and .doc file, convert to pdf For Each objFile in colFiles if stringEndsWith(objFile.Name,"docx",vbTextCompare) then filename = folder.Path & "\" & objFile.Name strLen = len(filename) outfilename = left(filename,strLen-5) & ".pdf" docToPdf filename,outfilename elseif stringEndsWith(objFile.Name,"doc",vbTextCompare) then filename = folder.Path & "\" & objFile.Name strLen = len(filename) outfilename = left(filename,strLen-4) & ".pdf" docToPdf filename,outfilename end if Next 'tranverse the sub folders For Each subFolder in folder.subFolders Set objFolder = objFSO.GetFolder(subFolder.Path) 'get the folder object Wscript.Echo TranversesubFolders objFSO,subFolder NextEnd Sub'Determines if a string ends with the same characters as'@param strValue the string to find the text'@param checkFor the string to be searched for'@param vbTextCompare for case-insenstive and vbBinaryCompare for case sensitive'@return True if end with checkFor, false otherwise'copied from http://www.freevbcode.com/ShowCode.asp?ID=2856Public Function stringEndsWith(ByVal strValue,byVal checkFor, byVal compareType) Dim sCompare Dim lLen lLen = Len(checkFor) If lLen > Len(strValue) Then Exit Function sCompare = Right(strValue, lLen) stringEndsWith = StrComp(sCompare, checkFor, compareType) = 0End FunctionFunction docToPdf(byVal docInputFile, byVal pdfOutputFile ) Dim wordApplication Dim wordDocument Dim wordDocuments Const wdDoNotSaveChanges = 0 Const wdFormatPDF = 17 'Dim currentDirectory 'Set fileSystemObject = CreateObject("Scripting.FileSystemObject") Set wordApplication = CreateObject("Word.Application") Set wordDocuments = wordApplication.Documents ' Disable any potential macros of the word document. wordApplication.WordBasic.DisableAutoMacros Set wordDocument = wordDocuments.Open(docInputFile) WScript.StdOut.Write "Saving "&pdfOutputFile&"..." ' See http://msdn2.microsoft.com/en-us/library/bb221597.aspx wordDocument.SaveAs pdfOutputFile, 17 WScript.StdOut.Write "Done!" Wscript.StdOut.WriteLine wordDocument.Close WdDoNotSaveChanges wordApplication.Quit WdDoNotSaveChanges Set wordApplication = Nothing 'Set fileSystemObject = NothingEnd Function'start of main programDim objFSO Dim objFolder Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(".")'starts with current folder TranversesubFolders objFSO,objFolder