Option Explicit Dim arrFileExt, arrFileTypes Dim blnOverwrite, blnTest Dim intConvertedFiles, intFileTypeOut, intMatchingFiles, intOverwriteErrors, intValidArgs Dim objFileIn, objFSO, objParentFolderIn Dim strExtensionIn, strFileNameIn, strFileSpecIn, strParentFolderIn Dim strExtensionOut, strFileNameOut, strFileSpecOut, strParentFolderOut Dim strFileIn, strFileOut, strFileTypeOut, strKey, strMsg, strResult Const wdFormatDocument = 0 Const wdFormatDocument97 = 0 Const wdFormatDocumentDefault = 16 Const wdFormatDOSText = 4 Const wdFormatDOSTextLineBreaks = 5 Const wdFormatEncodedText = 7 Const wdFormatFilteredHTML = 10 Const wdFormatFlatXML = 19 Const wdFormatFlatXMLMacroEnabled = 20 Const wdFormatFlatXMLTemplate = 21 Const wdFormatFlatXMLTemplateMacroEnabled = 22 Const wdFormatHTML = 8 Const wdFormatOpenDocumentText = 23 Const wdFormatPDF = 17 Const wdFormatRTF = 6 Const wdFormatStrictOpenXMLDocument = 24 Const wdFormatTemplate = 1 Const wdFormatTemplate97 = 1 Const wdFormatText = 2 Const wdFormatTextLineBreaks = 3 Const wdFormatUnicodeText = 7 Const wdFormatWebArchive = 9 Const wdFormatXML = 11 Const wdFormatXMLDocument = 12 Const wdFormatXMLDocumentMacroEnabled = 13 Const wdFormatXMLTemplate = 14 Const wdFormatXMLTemplateMacroEnabled = 15 Const wdFormatXPS = 18 blnOverwrite = False Set arrFileExt = CreateObject( "Scripting.Dictionary" ) ' Default file type based on extension only arrFileExt.Item( "doc" ) = 0 arrFileExt.Item( "docx" ) = 0 arrFileExt.Item( "htm" ) = 8 arrFileExt.Item( "html" ) = 8 arrFileExt.Item( "odt" ) = 23 arrFileExt.Item( "pdf" ) = 17 arrFileExt.Item( "rtf" ) = 6 arrFileExt.Item( "txt" ) = 4 arrFileExt.Item( "xml" ) = 19 arrFileExt.Item( "xps" ) = 18 Set arrFileTypes = CreateObject( "Scripting.Dictionary" ) ' All available file types arrFileTypes.Item( "Document" ) = 0 arrFileTypes.Item( "Document97" ) = 0 arrFileTypes.Item( "DocumentDefault" ) = 16 arrFileTypes.Item( "DOSText" ) = 4 arrFileTypes.Item( "DOSTextLineBreaks" ) = 5 arrFileTypes.Item( "EncodedText" ) = 7 arrFileTypes.Item( "FilteredHTML" ) = 10 arrFileTypes.Item( "FlatXML" ) = 19 arrFileTypes.Item( "FlatXMLMacroEnabled" ) = 20 arrFileTypes.Item( "FlatXMLTemplate" ) = 21 arrFileTypes.Item( "FlatXMLTemplateMacroEnabled" ) = 22 arrFileTypes.Item( "HTML" ) = 8 arrFileTypes.Item( "OpenDocumentText" ) = 23 arrFileTypes.Item( "PDF" ) = 17 arrFileTypes.Item( "RTF" ) = 6 arrFileTypes.Item( "StrictOpenXMLDocument" ) = 24 arrFileTypes.Item( "Template" ) = 1 arrFileTypes.Item( "Template97" ) = 1 arrFileTypes.Item( "Text" ) = 2 arrFileTypes.Item( "TextLineBreaks" ) = 3 arrFileTypes.Item( "UnicodeText" ) = 7 arrFileTypes.Item( "WebArchive" ) = 9 arrFileTypes.Item( "XML" ) = 11 arrFileTypes.Item( "XMLDocument" ) = 12 arrFileTypes.Item( "XMLDocumentMacroEnabled" ) = 13 arrFileTypes.Item( "XMLTemplate" ) = 14 arrFileTypes.Item( "XMLTemplateMacroEnabled" ) = 15 arrFileTypes.Item( "XPS" ) = 18 ' Command line parsing intValidArgs = 0 If WScript.Arguments.Named.Exists( "O" ) Then blnOverwrite = True intValidArgs = intValidArgs + 1 End If If WScript.Arguments.Named.Exists( "T" ) Then strFileTypeOut = WScript.Arguments.Named.Item( "T" ) If strFileTypeOut = "" Then strMsg = "Number:" & vbTab & "FileType:" & vbCrLf & "======" & vbTab & "======" & vbCrLf For Each strKey In arrFileTypes.Keys strMsg = strMsg & arrFileTypes.Item( strKey ) & vbTab & strKey & vbCrLf Next strMsg = strMsg & vbCrLf & "More details at:" & vbCrLf & "msdn.microsoft.com/library/office/ff839952" strMsg = strMsg & vbCrLf & vbCrLf & "Example: /T:18 or /T:XPS" If IsInGUI Then MsgBox strMsg, vbOKOnly, "List of Known File Types" Else WScript.Echo "List of Known File Types" & vbCrLf & vbCrLf & strMsg End If WScript.Quit 0 Else blnTest = False If arrFileTypes.Exists( strFileTypeOut ) Then strFileTypeOut = arrFileTypes.Item( strFileTypeOut ) blnTest = True ElseIf IsNumeric( strFileTypeOut ) Then For Each strKey In arrFileTypes.Keys If CStr( arrFileTypes.Item( strKey ) ) = CStr( strFileTypeOut ) Then blnTest = True End If Next End If If Not blnTest Then Syntax "Invalid file type." & vbCrLf & vbTab & "Use 'Word2Any.vbs /T' to list available file types." Else intValidArgs = intValidArgs + 1 End If End If End If If intValidArgs <> WScript.Arguments.Named.Count Then Syntax "Invalid command line switch(es)." End If Set objFSO = CreateObject( "Scripting.FileSystemObject" ) ' More command line parsing With objFSO If WScript.Arguments.Unnamed.Count = 1 Then strFileSpecIn = .GetAbsolutePathName( WScript.Arguments.Unnamed(0) ) strExtensionIn = .GetExtensionName( strFilespecIn ) strFileNameIn = .GetBaseName( strFilespecIn ) strParentFolderIn = .GetParentFolderName( strFilespecIn ) If strFileTypeOut = "" Then Syntax "Specify an output file name and/or file type." & vbCrLf & vbTab & "Use 'Word2Any.vbs /T' to list all available file types." Else For Each strKey In arrFileExt.Keys If CStr( arrFileExt.Item( strKey ) ) = CStr( strFileTypeOut ) Then strExtensionOut = strKey End If Next strFileNameOut = strFileNameIn strParentFolderOut = strParentFolderIn strFileSpecOut = .BuildPath( strParentFolderOut, strFileNameOut & "." & strExtensionOut ) End If ElseIf WScript.Arguments.Unnamed.Count = 2 Then strFileSpecIn = .GetAbsolutePathName( WScript.Arguments.Unnamed(0) ) strExtensionIn = .GetExtensionName( strFilespecIn ) strFileNameIn = .GetBaseName( strFilespecIn ) strParentFolderIn = .GetParentFolderName( strFilespecIn ) strFileSpecOut = WScript.Arguments.Unnamed(1) strExtensionOut = .GetExtensionName( strFileSpecOut ) strFileNameOut = .GetBaseName( strFileSpecOut ) strParentFolderOut = .GetParentFolderName( strFileSpecOut ) If strParentFolderOut = "" Then strParentFolderOut = strParentFolderIn Else strParentFolderOut = .GetAbsolutePathName( strParentFolderOut ) End If If strFileNameOut = "*" Then strFileNameOut = strFileNameIn strFileSpecOut = .BuildPath( strParentFolderOut, strFileNameOut & "." & strExtensionOut ) End If If strFileTypeOut = "" Then If arrFileExt.Exists( strExtensionOut ) Then strFileTypeOut = arrFileExt.Item( strExtensionOut ) Else Syntax "Unknown file type for this extension." & vbCrLf & vbTab & "Use '/T:filetype' to specify the file type." End If End If Else Syntax Null End If ' Command line validation If InStr( strFileSpecIn, "?" ) Or InStr( strFileSpecOut, "?" ) Then Syntax "No ""?"" wildcards allowed in input or output paths." End If If InStr( strExtensionIn, "*" ) Or InStr( strExtensionOut, "*" ) Then Syntax "No wildcards allowed in file extensions." End If If InStr( strParentFolderIn, "*" ) Or InStr( strParentFolderOut, "*" ) Then Syntax "No wildcards allowed in folder paths." End If If ( InStr( strFileNameIn, "*" ) And Not strFileNameIn = "*" ) Or ( InStr( strFileNameOut, "*" ) And Not strFileNameOut = "*" ) Then Syntax "Wildcard ""*"" can only be the entire file name, not a part of it." End If If Not .FolderExists( strParentFolderIn ) Then Syntax "Specified input folder not found." End If If Not .FolderExists( strParentFolderOut ) Then Syntax "Specified output folder not found." End If If strFileNameIn = "*" And Not strFileNameOut = "*" Then Syntax "If the input file name is a ""*"" wildcard, the output file name must be a ""*"" wildcard too." End If If strFileNameIn = "*" Then intMatchingFiles = 0 For Each strFileIn In .GetFolder( strParentFolderIn ).Files If LCase( .GetExtensionName( strFileIn ) ) = LCase( strExtensionIn ) Then intMatchingFiles = intMatchingFiles + 1 End If Next If intMatchingFiles = 0 Then Syntax "No files matching Word documents specification." End If Else If Not .FileExists( strFileSpecIn ) Then Syntax "The specified Word document does not exist." End If End If ' The actual conversion is done by the Doc2Other subroutine If strFileNameIn = "*" Then intOverwriteErrors = 0 intConvertedFiles = 0 strMsg = "" For Each objFileIn In .GetFolder( strParentFolderIn ).Files strFileIn = objFileIn.Path If LCase( .GetExtensionName( strFileIn ) ) = LCase( strExtensionIn ) Then strFileOut = .BuildPath( strParentFolderOut, .GetBaseName( strFileIn ) & "." & strExtensionOut ) strMsg = strMsg & "Converting """ & .GetFileName( strFileIn ) & """ to """ & .GetFileName( strFileOut ) & """ . . ." & vbCrLf strResult = Doc2Other( strFileIn, strFileOut, strFileTypeOut, blnOverwrite ) If IsNull( strResult ) Then intConvertedFiles = intConvertedFiles + 1 Else intOverwriteErrors = intOverwriteErrors + 1 strMsg = strMsg & "ERROR:" & vbTab & strMsg & vbCrLf End If End If Next WScript.Echo strMsg & vbCrLf & intConvertedFiles & " documents successfully converted, " & intOverwriteErrors & " existing files were skipped." & vbCrLf If intOverwriteErrors > 0 Then Syntax intOverwriteErrors & " existing files were skipped." & vbCrLf & vbTab & "Use '/O' to silently overwrite existing files." End If Else strResult = Doc2Other( strFileSpecIn, strFileSpecOut, strFileTypeOut, blnOverwrite ) If Not IsNull( strResult ) Then Syntax strResult End If End With ' Finished Set objFSO = Nothing Set arrFileTypes = Nothing Function Doc2Other( myInputFile, myOutputFile, myFileType, myBoolOverwrite ) Dim objDoc, objFSO, objWord, strMsg strMsg = Null Set objFSO = CreateObject( "Scripting.FileSystemObject" ) If objFSO.FileExists( myOutputFile ) And Not myBoolOverwrite Then strMsg = """" & objFSO.GetFileName( myOutputFile ) & """ already exists." & vbCrLf & vbTab & "Use '/O' to silently overwrite existing files." & vbCrLf Else On Error Resume Next Set objWord = CreateObject( "Word.Application" ) If Err Then Err.Clear strMsg = "Unable to access MS Word. Make sure MS Office is installed" & vbCrLf & vbTab & "(MSI based installation, NOT a ""click-to-run"" installation)." Else objWord.Visible = True objWord.Documents.Open myInputFile If Err Then Err.Clear strMsg = "Unable to open the input document in Microsoft Word." Else Set objDoc = objWord.ActiveDocument objDoc.SaveAs myOutputFile, CLng( myFileType ) If Err Then Err.Clear strMsg = "Unable to save the document in the requested format." End If objDoc.Close If Err Then Err.Clear strMsg = strMsg & vbCrLf & vbTab & "Unable to close the input document." End If Set objDoc = Nothing End If objWord.Quit Set objWord = Nothing End If On Error Goto 0 End If Doc2Other = strMsg End Function Function IsInGUI( ) IsInGUI = Not ( Right( LCase( WScript.FullName ), 12 ) = "\cscript.exe" ) End Function Sub Syntax( myMessage ) Dim strMsg On Error Resume Next objDoc.Close objWord.Quit Set objDoc = Nothing Set objWord = Nothing Set objFSO = Nothing Set arrFileTypes = Nothing On Error Goto 0 strMsg = "" If Trim( " " & myMessage ) <> "" Then strMsg = vbCrLf & "ERROR:" & vbTab & myMessage & vbCrLf ' Irregular looking whitespace allows proper alignment in both Console and GUI mode (fixed width vs proportional fonts) strMsg = strMsg _ & vbCrLf _ & "Word2Any.vbs, Version 1.01" _ & vbCrLf _ & "Open a Microsoft Word document and save it in ""any"" (known) format" _ & vbCrLf & vbCrLf _ & "Usage: " & vbTab & "WORD2ANY.VBS ""wordfile"" [ ""outfile"" ] [ options ]" _ & vbCrLf & vbCrLf _ & "Where: " & vbTab & """wordfile""" & vbTab & "Word document(s) to be converted (wildcard" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "allowed for file name, e.g. ""*.docx"")" _ & vbCrLf _ & " " & vbTab & """outfile""" & vbTab & "output file(s) to be created (wildcard allowed" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "for file name, e.g. ""*.pdf"" or ""*.html"")" _ & vbCrLf _ & "Options:" & vbTab & "/O " & vbTab & "silently overwrite existing output file(s)" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "(default: abort if output file exists)" _ & vbCrLf _ & " " & vbTab & "/T " & vbTab & "list available output file types" _ & vbCrLf _ & " " & vbTab & "/T:type " & vbTab & "set output file type (required if ""outfile""" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "not specified; type may be number or string)" _ & vbCrLf & vbCrLf _ & "Notes: " & vbTab & "[1]" & vbTab & "This script requires a ""regular"" (MSI based)" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "Microsoft Word installation, it WILL FAIL on" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "a ""click-to-run"" installation of MS Office." _ & vbCrLf _ & " " & vbTab & "[2]" & vbTab & "For Word 2007, to save as PDF or XPS this script" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "requires the ""Microsoft Save as PDF or XPS Add-in for" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "2007 Microsoft Office programs"", available at:" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "www.microsoft.com/en-us/download/details.aspx?id=7" _ & vbCrLf _ & " " & vbTab & "[3]" & vbTab & "If wildcard ""*"" is used for the Word document, and" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "the /O switch is not used, the script will display an" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "error message in case an output file already exists," _ & vbCrLf _ & " " & vbTab & " " & vbTab & "but it will then continue to convert the next file" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "instead of aborting." _ & vbCrLf _ & " " & vbTab & "[4]" & vbTab & "If Word was already active when this script is started," _ & vbCrLf _ & " " & vbTab & " " & vbTab & "the other document(s) will be left alone, and only the" _ & vbCrLf _ & " " & vbTab & " " & vbTab & "document opened by this script will be closed." _ & vbCrLf & vbCrLf _ & "Examples:" & vbTab & "WORD2ANY.VBS ""D:\folder\myfile.doc"" *.pdf" _ & vbCrLf _ & " " & vbTab & "will save to ""D:\folder\myfile.pdf""" _ & vbCrLf & vbCrLf _ & " " & vbTab & "WORD2ANY.VBS ""D:\folder\myfile.docx"" ""D:\otherfolder\*.rtf""" _ & vbCrLf _ & " " & vbTab & "will save to ""D:\otherfolder\myfile.rtf""" _ & vbCrLf & vbCrLf _ & " " & vbTab & "WORD2ANY.VBS ""D:\folder\myfile.rtf"" ""D:\elsewhere\newfile.xps""" _ & vbCrLf _ & " " & vbTab & "will save to ""D:\elsewhere\newfile.xps""" _ & vbCrLf & vbCrLf _ & " " & vbTab & "WORD2ANY.VBS ""D:\folder\*.doc"" *.html" _ & vbCrLf _ & " " & vbTab & "will save all matching files as HTML to ""D:\folder\""" _ & vbCrLf & vbCrLf _ & " " & vbTab & "WORD2ANY.VBS ""D:\folder\*.doc"" /T:8" _ & vbCrLf _ & " " & vbTab & "same as previous example, but more file types available" _ & vbCrLf & vbCrLf _ & " " & vbTab & "WORD2ANY.VBS /T" _ & vbCrLf _ & " " & vbTab & "will list all available file types" _ & vbCrLf & vbCrLf _ & "Written by Rob van der Woude" _ & vbCrLf _ & "http://www.robvanderwoude.com" WScript.Echo strMsg WScript.Quit 1 End Sub