Source code for word2xps.vbs

Option Explicit

Doc2XPS "C:\Documents and Settings\MyUserID\My Documents\resume.doc"

Sub Doc2XPS( myFile )

' This subroutine opens a Word document, then saves it as XPS, and closes Word.

' If the XPS file exists, it is overwritten.

' If Word was already active, the subroutine will leave the other document(s)

' alone and close only its "own" document.

'

' Requirements:

' This script requires the "Microsoft Save as PDF or XPS Add-in for 2007

' Microsoft Office programs", available at:

' http://www.microsoft.com/downloads/details.aspx?

'        familyid=4D951911-3E7E-4AE6-B059-A2E79ED87041&displaylang=en

'

' Written by Rob van der Woude

' http://www.robvanderwoude.com

	' Standard housekeeping

	Dim objDoc, objFile, objFSO, objWord, strFile, strXPS

	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 wdFormatPDF                         = 17

	Const wdFormatRTF                         =  6

	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

	' Create a File System object

	Set objFSO = CreateObject( "Scripting.FileSystemObject" )

	' Create a Word object

	Set objWord = CreateObject( "Word.Application" )

	With objWord

		' True: make Word visible; False: invisible

		.Visible = True

		' Check if the Word document exists

		If objFSO.FileExists( myFile ) Then

			Set objFile = objFSO.GetFile( myFile )

			strFile = objFile.Path

		Else

			WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf

			' Close Word

			.Quit

			Exit Sub

		End If

		' Build the fully qualified XPS file name

		strXPS = objFSO.BuildPath( objFile.ParentFolder, _

		          objFSO.GetBaseName( objFile ) & ".xps" )

		' Open the Word document

		.Documents.Open strFile

		' Make the opened file the active document

		Set objDoc = .ActiveDocument

		' Save in XML Paper Specification (XPS) format

		objDoc.SaveAs strXPS, wdFormatXPS

		' Close the active document

		objDoc.Close

		' Close Word

		.Quit

	End With

End Sub