After some trail and error from my previous post we went through batch converting 300+ Visio vsd files over to vsdx. Overall the files size was reduced by 70%, dropping from over 6 Gb to around 2Gb, and allowing the files to open/save to the network a lot quicker. The only caveat I found was Visio 64-bit is the best way to do this and is most stable, especially with files over 25Mb. Above about 33 – 35Mb and the 32-bit version would randomly crash. With that said I added in some basic error detection to skip corrupt Visio files, some user variables to keep personal info or remove along with deleting the original file or not, and the ability to do sub directories. Here is the modified code:
Public FilesAttempted As Integer
Public FilesConverted As Integer
Public FilesDeleted As Integer
Public FilesSkipped As String
FilesAttempted = 0
FilesConverted = 0
FilesDeleted = 0
FilesSkipped = ""
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Dim HostFolder As String
Dim DeleteOriginal As Boolean
Dim RemovePersonal As Boolean
''' HostFolder is directory to start it. Change to your base directory.
HostFolder = "T:\"
''' DeleteOriginal will delete the original file as long as the VSDX was created. Either True or False
DeleteOriginal = True
''' RemovePersonal will remove personal information from the file. Reduces the size a little but you might want to keep the original info
RemovePersonal = False
DoFolder FileSystem.GetFolder(HostFolder), DeleteOriginal
MsgBox "Conversion complete! " & vbCrLf & vbCrLf & "Files attempted: " & FilesAttempted & vbCrLf & "Files converted: " & FilesConverted & vbCrLf & "Files deleted: " & _
FilesDeleted & vbCrLf & "Files with issues: " & vbCrLf & FilesSkipped, vbOKOnly + vbInformation, "Conversion Complete"
Sub DoFolder(Folder, DeleteOriginal)
On Error GoTo ErrHandler:
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder, DeleteOriginal
For Each File In Folder.Files
' For each file name sure its a vsd and not a temp file
If ((Right(File, 3) = "vsd") And (Right(File, 4) <> "~vsd")) Then
FilesAttempted = FilesAttempted + 1
' Open the file
' Remote personal info if set
If RemovePersonal = True Then
Application.ActiveDocument.RemovePersonalInformation = True
' Loop through each master then check across pages to see if it is used
Index = Application.ActiveDocument.Masters.Count
While Index > 0
bMasterUsed = False
Set oMaster = Application.ActiveDocument.Masters.Item(Index)
For Each oPage In Application.ActiveDocument.Pages
For Each oShape In oPage.Shapes
If oMaster.Name = oShape.Name Then
bMasterUsed = True
' if Not used delete it from the document stencil
If bMasterUsed = False Then
Index = Index - 1
' Save as a vsdx and increase our counter
Application.ActiveDocument.SaveAs File & "x"
FilesConverted = FilesConverted + 1
' Delete the original if set and the new vsdx exists
If ((DeleteOriginal = "True") And (FileExists(File & "x"))) Then
SetAttr File, vbNormal
FilesDeleted = FilesDeleted + 1
Debug.Print "Error encountered. Error number: " & Err.Number & " - Error description: " & Err.Description
If File <> "" Then
FilesSkipped = FilesSkipped & File & vbCrLf
Function FileExists(ByVal FileToTest As String) As Boolean
FileExists = (Dir(FileToTest) <> "")
If you use this please let me know how it goes or any tweaks that need to be made.
3 thoughts on “Update to Batch Converting Visio Files”
This worked perfectly, thank you for posting this!
We’re moving a ton of Office documents to SharePoint online and many of the old VSD files won’t even preview. Your code made it easy for me to convert them all, and everyone is much happier. Thank you!
I have just dowloaded Your VBA script to convert VSD files to VSDX. It’s running perfectly
Question: is it possible in VBA to present the users to select the root folder instead of writing the path in VBA (ex. HostFolder = “C:\Temp\” ? If Yes, how can I change the VBA Code?
Yes but I have never tried it. You will want to search for “VBA Folder Picker”. It will be something like this that would go after the current “HostFolder” line (so you have a default value and then the one the user selects)
If .Show = -1 Then ‘ if OK is pressed
HostFolder = .SelectedItems(1)