Convert Excel .xls to .xlsx and .xlsm using VBA

Here are some Excel macros to quickly convert .xls files to .xlsx and .xlsm formats for newer versions of Microsoft Excel. Just paste this in your VBA window (in a module) in a .xlsm file, and use Excel to automatically do its own conversions. You then run either macro, which will ask you to choose a folder, and then all .xls files will be converted to .xlsx or .xlsm depending on whether they have macros or not...


Sub Copy_XLS_as_XLSX()

    Convert_XLS_to_XLSX False
 
End Sub

Sub Delete_XLS_after_Copy_XLS_as_XLSX()

    Convert_XLS_to_XLSX True
 
End Sub

Sub Convert_XLS_to_XLSX(ByVal deleteXLS As Boolean)
 
    ' Allow user to choose a folder,  where all .xls files in that folder will be converted to
    ' .xlsx or .xlsm format, depending on whether they have macros or not...
 
     
 
    Dim xDirect$, xFname$, InitialFoldr$
    Dim wbk As New Workbook
    Dim msg As Integer
 
 
 
    InitialFoldr$ = "c:\temp\"    'Startup folder to begin searching from
 
    If deleteXLS = True Then  'as user if they really want to delete .xls files
                 
        msg = MsgBox("Do you want to delete all .xls files after you have created a copy in .xlsx format? If you are not sure, click NO!", vbYesNo, "Ready to delete .xls files?")
 
    End If
 
    If msg = vbNo Then  'user doesn't want to delete files...
 
        deleteXLS = False
     
    End If
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder containing the .xls files you want to convert..."
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
         
            Do While xFname$ <> ""  'loop through all filenames in folder
         
                If Right(xFname$, 4) = ".xls" Then  'only convert .xls files
             
                    Application.DisplayAlerts = False  'turn off any unwanted messages
                 
                    Set wbk = Workbooks.Open(Filename:=xDirect$ & xFname$)
         
                    If wbk.HasVBProject Then  ' convert Excel files containing Macros
                      wbk.SaveAs Filename:=xDirect$ & xFname$ & "m", _
                        FileFormat:=xlOpenXMLWorkbookMacroEnabled
                     
                    Else  ' convert standard Excel files
                       wbk.SaveAs Filename:=xDirect$ & xFname$ & "x", _
                        FileFormat:=xlOpenXMLWorkbook
                    End If
                 
                    wbk.Close SaveChanges:=False
                 
                    If deleteXLS = True Then  'delete existing xls files if desired
                 
                        With New FileSystemObject 'include Excel reference to Microsoft Scripting.Runtime library... or this won't work...  Go to Tools>References in the VBA editing window
                     
                            If .FileExists(xDirect$ & xFname$) Then
                                .DeleteFile xDirect$ & xFname$
                            End If
                         
                        End With
                     
                    End If
                 
                    Application.DisplayAlerts = True  'turn messages back on
                 
                End If
             
                xFname$ = Dir  ' get next filename in folder
             
            Loop
         
        End If
     
    End With
 
    xRow = MsgBox("All .xls files have now been converted.", , "Finished!")
 
 
 
End Sub