Skip to content

Instantly share code, notes, and snippets.

@tomfa
Last active October 2, 2015 13:46
Show Gist options
  • Save tomfa/ff3806d887cd10d6bc84 to your computer and use it in GitHub Desktop.
Save tomfa/ff3806d887cd10d6bc84 to your computer and use it in GitHub Desktop.
VBscript that saves Office binary files as OpenXML formats, e.g. doc to dox. Either single files or recursive through subfolders. Office >= 2007 must be installed for this to work. 1) Save as converter.vbs 2) Go to folder i cmd. 3) Run with "cscript converter.vbs path/to/folder"
Dim arguments
Set arguments = WScript.Arguments
' http://msdn2.microsoft.com/en-us/library/bb238158.aspx
Const wdFormatXMLDocument = 12 ' docx
' https://technet.microsoft.com/en-us/library/ff198017.aspx
Const xlOpenXMLWorkbook = 51 ' xlsx
' https://msdn.microsoft.com/en-us/library/office/ff746500.aspx
Const ppSaveAsOpenXMLPresentation = 24 ' pptx
Const DoNotSaveChanges = 0
Dim fileSystemObject
Dim inputArg
Dim filExt
Dim destinationPath
Dim wordApplication
Dim wordDocument
Dim excelApplication
Dim excelDocument
Dim powerpointApplication
Dim powerpointDocument
Set fso = CreateObject ("Scripting.FileSystemObject")
Set stdout = fso.GetStandardStream (1)
Set stderr = fso.GetStandardStream (2)
Function CheckUserArguments()
If arguments.Unnamed.Count <> 1 Then
WScript.Echo "Use:"
WScript.Echo "<script> path\inputfolder"
WScript.Echo "<script> path\inputArg"
WScript.Quit 1
End If
End Function
Function InitializeWord()
Set wordApplication = CreateObject("Word.Application")
wordApplication.WordBasic.DisableAutoMacros
End Function
Function InitializeExcel()
Set excelApplication = CreateObject("Excel.Application")
excelApplication.DisplayAlerts = False
excelApplication.EnableEvents = False
End Function
Function InitializePowerpoint()
Set powerpointApplication = CreateObject("PowerPoint.Application")
End Function
Function Initialize()
inputArg = arguments.Unnamed.Item(0)
inputArg = fso.GetAbsolutePathName(inputArg)
End Function
Function DocToDocx(file)
file = fso.GetAbsolutePathName(file)
If Not IsObject(wordApplication) Then
Call InitializeWord()
End If
destinationPath = file + "x"
Set wordDocument = wordApplication.Documents.Open(file)
wordDocument.SaveAs destinationPath, wdFormatXMLDocument
wordDocument.Close DoNotSaveChanges
set wordDocument = Nothing
End Function
Function XlsToXlsx(file)
file = fso.GetAbsolutePathName(file)
If Not IsObject(excelApplication) Then
Call InitializeExcel()
End If
destinationPath = file + "x"
Set excelDocument = excelApplication.Workbooks.Open(file)
excelDocument.SaveAs destinationPath, xlOpenXMLWorkbook
excelDocument.Close DoNotSaveChanges
set excelDocument = Nothing
End Function
Function PptToPptx(file)
file = fso.GetAbsolutePathName(file)
If Not IsObject(powerpointApplication) Then
Call InitializePowerpoint()
End If
destinationPath = file + "x"
Set powerpointDocument = powerpointApplication.Presentations.Open(file, True, False, False)
powerpointDocument.SaveAs destinationPath, ppSaveAsOpenXMLPresentation
powerpointDocument.Close
set powerpointDocument = Nothing
End Function
Function Close()
if IsObject(wordApplication) Then
wordApplication.Quit DoNotSaveChanges
Set wordApplication = Nothing
End If
if IsObject(excelApplication) Then
excelApplication.Quit
Set excelApplication = Nothing
End If
if IsObject(powerpointApplication) Then
powerpointApplication.Quit
Set powerpointApplication = Nothing
End If
Set fso = Nothing
Set arguments = Nothing
End Function
Function GetFileExt(file)
GetFileExt = fso.GetExtensionName(file)
End Function
Function Convert(objFile)
filExt = GetFileExt(objFile)
Select Case filExt
Case "xls"
stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
XlsToXlsx(objFile)
Case "ppt"
stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
PptToPptx(objFile)
Case "doc"
stdout.WriteLine "Converting " & fso.GetAbsolutePathName(objFile)
DocToDocx(objFile)
Case Else
stdout.WriteLine "Ignoring: " & fso.GetAbsolutePathName(objFile)
End Select
End Function
Function ConvertFolders(objStartFolder)
Set objFolder = fso.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
Convert(objFile)
Next
For Each Subfolder in objFolder.SubFolders
ConvertFolders Subfolder.Path
Next
End Function
Call CheckUserArguments()
Call Initialize()
If (fso.FileExists(inputArg)) Then Call Convert(inputArg)
If (fso.FolderExists(inputArg)) Then Call ConvertFolders(inputArg)
Call Close()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment