Step 1: Save the following script. For example: DocToPDF.vbs
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
option Explicit '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 WScript.StdOut.Write "opening "&docInputFile&"..." Set wordDocument = wordDocuments.Open(docInputFile) WScript.StdOut.Write "Done!" Wscript.StdOut.WriteLine 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 = NothingEnd Function'start of main programDim objFSO Dim args Dim arg Dim filename Dim outfilename Dim strLen Set objFSO = CreateObject("Scripting.FileSystemObject") Set args = Wscript.Arguments For Each arg In args Wscript.Echo arg if stringEndsWith(arg,"docx",vbTextCompare) then filename = objFSO.GetAbsolutePathName(arg) strLen = len(filename) outfilename = left(filename,strLen-5) & ".pdf" docToPdf filename,outfilename elseif stringEndsWith(arg,"doc",vbTextCompare) then filename = objFSO.GetAbsolutePathName(arg) strLen = len(filename) outfilename = left(filename,strLen-4) & ".pdf" docToPdf filename,outfilename end ifNext
Step 2: Save the following registry file. For example: test.reg
In my case, I saved the DocToPDF.vbs into "c:\programming". Please change it into the directory you saved the script.
1 2 3 4 5 6 7 8 9 10 11 12 13
Windows Registry Editor Version 5.00 [HKEY_CLASSES_ROOT\Word.Document.8\shell\Save as PDF]@="&Save as PDF"[HKEY_CLASSES_ROOT\Word.Document.8\shell\Save as PDF\command]@="cscript.exe c:\\\\programming\\\\DocToPDF.vbs \"%1\""[HKEY_CLASSES_ROOT\Word.Document.12\shell\Save as PDF]@="&Save as PDF"[HKEY_CLASSES_ROOT\Word.Document.12\shell\Save as PDF\command]@="cscript.exe c:\\\\programming\\\\DocToPDF.vbs \"%1\""
Step 3: Double click on the registry file created above to add the entries into the registry.