Source code for word2any.vbs

```
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
```
```
 
```