ConvertVisioToPNG.vbs

ConvertVisioToPNG.vbs

Option Explicit 
'################################################
'This script is to export Visio and PUML files to PNG files
'################################################

Sub main()
	Dim ArgCount, argumentPath, workItems, skipped, scriptdir

	ArgCount = WScript.Arguments.Count
	
	if ArgCount <> 1 then
		if(ArgCount = 0) then
			scriptdir = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
			' no arguments - lets grab all the PUML files in the current dir and convert those 
			workItems = Split(GetFilesWithExtension(scriptdir, "puml"), "|")
			For each argumentPath in workItems			
				ConvertPlantUML(argumentPath)
			Next
		end if

		'Assuming multiple PUML files have been passed.
		For each argumentPath in WScript.Arguments
			if(IsPlantUMLFile(argumentPath)) then
				ConvertPlantUML(argumentPath)
			Else
				skipped = skipped & " " & argumentPath
			end if
		Next
		if Len(skipped) > 0 then			
			WScript.Echo "Skipped these items (multiple file conversion only supported for PUML):" & skipped
		end if
		WScript.Quit	
	end If

	
	argumentPath = WScript.Arguments(0)
	if(IsVisioFile(argumentPath)) then
		ConvertVisio(argumentPath)
	end if

	if(IsPlantUMLFile(argumentPath)) then
		ConvertPlantUML(argumentPath)
	end if

end Sub

Sub ConvertVisio(argumentPath)

	'MsgBox "Please please make sure you drag a Visio file or folder that contains some Visio files,and press 'OK' to continue",,"Information"
	Dim objshell	

	Set objshell = CreateObject("scripting.filesystemobject")
	If objshell.FolderExists(argumentPath) Then  'Check if the object is a folder
		Dim flag,FileNumber
		flag = 0 
		FileNumber = 0 	
		Dim Folder,VisioFiles,VisioFile		
		Set Folder = objshell.GetFolder(argumentPath)
		Set VisioFiles = Folder.Files
		For Each VisioFile In VisioFiles  'loop the files in the folder
			FileNumber = FileNumber + 1 
			VisioFile = VisioFile.Path
			If IsVisioFile(VisioFile) Then  'if the file is Visio file, then convert it 
				ConvertVisioToPNG VisioFile
				flag = flag + 1
			End If 	
		Next 
		WScript.Echo "Totally " & FileNumber & " files in the folder and convert " & flag & " Visio file(s) to PNG fles."	
	Else 
		If IsVisioFile(argumentPath) Then  'if the object is a file,then check if the file is a Visio file and convert it 
			Dim VisioPath
			VisioPath = argumentPath
			ConvertVisioToPNG VisioPath
		Else 
			WScript.Echo "Please please make sure you drag a Visio file or a folder that contains some Visio files."
		End If  
	End If 
End Sub 

Function ConvertVisioToPNG(VisioFile)  'This function is to convert a Visio file to PNG file
	Dim objshell,ParentFolder,fileBaseName, fileName,Visioapp,Visio, exportPath, tmpFilePath, exportThumbnail

	Set objshell= CreateObject("scripting.filesystemobject")
	fileBaseName = objshell.GetBaseName(VisioFile) 'Get the file name
	fileName = objshell.GetFileName(VisioFile) 'Get the file name		
	ParentFolder = objshell.GetParentFolderName(VisioFile) 'Get the current folder path
	tmpFilePath = ParentFolder & "\tmp_" & fileName
	objshell.CopyFile VisioFile, tmpFilePath, true

	Set Visioapp = CreateObject("Visio.Application")
	Visioapp.Visible = False
	'MsgBox VisioFile
	'MsgBox tmpFilePath

	Set Visio = Visioapp.Documents.Open(tmpFilePath)
	Set Pages = Visioapp.ActiveDocument.Pages	
	
	' create the export folder
	exportPath = ParentFolder & "\Exports\" 
	if(objshell.FolderExists(exportPath) <> True) Then
		objshell.CreateFolder(exportPath)
	End If

	' create the file folder
	exportPath = exportPath & fileBaseName & "\" 'Set the exportPath
	exportThumbnail = exportPath & "Thumbnails\"
	if(objshell.FolderExists(exportPath) <> True) Then
		objshell.CreateFolder(exportPath)
	End If
	if(objshell.FolderExists(exportThumbnail) <> True) Then
		objshell.CreateFolder(exportThumbnail)
	End If

	Dim PageName,Page,Pages,PageNumber,PageNumberFormatted
	PageNumber = 1
	
	For Each Page In Pages
		if PageNumber < 10 then
			PageNumberFormatted = "0"&PageNumber
		Else
			PageNumberFormatted = ""&PageNumber
		end if

		PageName = Page.Name
		if InStr(1,PageName,"ignore") <> 1 then ' Skip any pages that have a name starting with "ignore"			
			'set the resolution  https://msdn.microsoft.com/en-us/library/office/ff765624(v=office.14).aspx
			Visioapp.Settings.SetRasterExportResolution 3, 160, 160, 0
			Page.Export(exportPath & PageNumberFormatted & ". " & PageName & ".png")

			' THUMBNAILS
			Visioapp.Settings.SetRasterExportResolution 3, 32, 32, 0
			Page.Export(exportThumbnail & PageNumberFormatted & ". " & PageName & ".png")

			PageNumber = PageNumber +1
		end if		
	Next
	
	Visio.Close
	Visioapp.Quit
	objshell.DeleteFile(tmpFilePath)
	Set objshell = Nothing 
End Function 


Sub ConvertPlantUML(argumentPath)
	'java -jar C:\development\bit\plantuml.jar -o "Exports" "*.puml"
	Dim WshShell, objshell, fileBaseName
	Set WshShell = WScript.CreateObject("WScript.Shell")
	Set objshell= CreateObject("scripting.filesystemobject")
	fileBaseName = objshell.GetBaseName(argumentPath) 'Get the file name

	'MSgBox "java -jar C:\development\bit\plantuml.jar -o Exports " & argumentPath

	WshShell.Run "java -jar C:\development\bit\plantuml.jar -o Exports " & argumentPath, 0, True

	Set WshShell = Nothing
End Sub

Function IsVisioFile(VisioFile) 
	Dim objshell
	Set objshell= CreateObject("scripting.filesystemobject")
	Dim Arrs ,Arr
	Arrs = Array("vsdx","vssx","vstx","vxdm","vssm","vstm","vsd","vdw","vss","vst")
	
	Dim blnIsVisioFile,FileExtension
	blnIsVisioFile = False 
	FileExtension = objshell.GetExtensionName(VisioFile)  'Get the file extension
	For Each Arr In Arrs
		If InStr(UCase(FileExtension),UCase(Arr)) <> 0 Then 
			blnIsVisioFile= True
			Exit For 
		End If 
	Next 
	IsVisioFile = blnIsVisioFile
	Set objshell = Nothing 
End Function


Function IsPlantUMLFile(filePath) 
	Dim objshell
	Set objshell= CreateObject("scripting.filesystemobject")
	Dim exts ,ext
	exts = Array("puml")
	
	Dim hasExtension,FileExtension
	hasExtension = False 
	FileExtension = objshell.GetExtensionName(filePath)  'Get the file extension
	For Each ext In exts
		If InStr(UCase(FileExtension),UCase(ext)) <> 0 Then 
			hasExtension= True
			Exit For 
		End If 
	Next 
	IsPlantUMLFile = hasExtension
	Set objshell = Nothing 
End Function

Sub GetFilesWithExtension(path, extension)
    Dim objFile, objFSO, ret
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	objFolder = objFSO.GetFolder(path)
	
    For Each objFile In objFolder.Files
        If LCase(objFSO.GetExtensionName(objFile.Name)) = extension Then
            ret = ret & "|" & objFile.Name
        End If
    Next
	set objFSO = Nothing
	return ret
End Sub

Call main