Thursday, March 28, 2013

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$
        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", _
                    Else  ' convert standard Excel files
                       wbk.SaveAs Filename:=xDirect$ & xFname$ & "x", _
                    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
        End If
    End With
    xRow = MsgBox("All .xls files have now been converted.", , "Finished!")
End Sub