A little while back I posted a macro to batch covert Visio VSD files to VSDX files which got a decent number of people messaging me. Recently I found how many excel files we had using the old format which just like old Visio files take up a lot of extra space. So I went through and modified my Visio converter over for Excel. So here is a step by step to write your own Excel file converter:
- Open a new Excel document. Save it as a “Excel Macro-Enabled Workbook (*.xlsm)
- In the first cell put something like “To run the conversion hit ALT+F11 to open the program then F5 to run it”.
- Hit ALT+F11 to open up the Microsoft Visual Basic for Applications screen
- Right click “ThisWorkbook” at the top left then Insert -> Module
- In the module copy and paste the following in:
Public FilesAttempted As Integer Public FilesConverted As Integer Public FilesDeleted As Integer Public FilesSkipped As String Sub ConvertToXlsx() 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 at. Change to your base directory. HostFolder = "C:\temp" ''' DeleteOriginal will delete the original file as long as the xlsx was created. Either True or False DeleteOriginal = 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" End Sub Sub DoFolder(Folder, DeleteOriginal) On Error GoTo ErrHandler: Dim SubFolder For Each SubFolder In Folder.SubFolders DoFolder SubFolder, DeleteOriginal Next Dim File Dim myWorkbook As Workbook For Each File In Folder.Files ' For each file name sure its a xls and not a temp file If ((Right(File, 3) = "xls") And (Right(File, 4) <> "~xls")) Then FilesAttempted = FilesAttempted + 1 ' Open the file Set myWorkbook = Workbooks.Open(File) ' Save as a xlsx and increase our counter myWorkbook.SaveAs Filename:=File & "x", FileFormat:=xlOpenXMLWorkbook myWorkbook.Close (False) FilesConverted = FilesConverted + 1 ' Delete the original if set and the new xlsx exists If ((DeleteOriginal = "True") And (FileExists(File & "x"))) Then SetAttr File, vbNormal Kill File FilesDeleted = FilesDeleted + 1 End If NextFile: End If Next Done: Exit Sub ErrHandler: Debug.Print "Error encountered. Error number: " & Err.Number & " - Error description: " & Err.Description If File <> "" Then FilesSkipped = FilesSkipped & File & vbCrLf GoTo NextFile: End If End Sub Function FileExists(ByVal FileToTest As String) As Boolean FileExists = (Dir(FileToTest) <> "") End Function
Change the HostFolder to the directory you want to run this on and hit F5 to run. It will open each Excel workbook with a xls extension in that directory, and all sub directories, then save it as a xlsx. If you want it to automatically delete the old xls file change the DeleteOriginal variable to True or just manually delete them after conversion.