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:

1. Open a new Excel document. Save it as a “Excel Macro-Enabled Workbook (*.xlsm)
2. In the first cell put something like “To run the conversion hit ALT+F11 to open the program then F5 to run it”.
3. Hit ALT+F11 to open up the Microsoft Visual Basic for Applications screen
4. Right click “ThisWorkbook” at the top left then Insert -> Module
5. 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.