How to look in all folders in directory to change file extensions of excel file

Question

I have a lot of.xls excel files spread over several directories. These should be changed to have the.xlsx file extension. If I specify the folder file location, my code functions perfectly. However, I would like to change it so that it searches through all folders in the directory and instantly converts any.xls files to.xlsx. I feel a bit stuck. Below is my code:

    Dim strCurrentFileExt   As String
    Dim strNewFileExt       As String
    Dim objFSO              As Object
    Dim objFolder           As Object
    Dim objFile             As Object
    Dim xlFile              As Workbook
    Dim strNewName          As String
    Dim strFolderPath       As String

    strCurrentFileExt = ".xls"
    strNewFileExt = ".xlsx"

    strFolderPath = "C:\myExcelFolders"
    If Right(strFolderPath, 1) <> "\" Then
        strFolderPath = strFolderPath & "\"
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.getfolder(strFolderPath)
    For Each objFile In objFolder.Files
        strNewName = objFile.Name
        If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
            Set xlFile = Workbooks.Open(objFile.Path, , True)
            strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
            Application.DisplayAlerts = False
            Select Case strNewFileExt
            Case ".xlsx"
                xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbook
            Case ".xlsm"
                xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
            End Select
            xlFile.Close
            Application.DisplayAlerts = True
        End If
    Next objFile

narikkadan · Answer 1 · Nov 24, 2022

Loop Through All Subfolders Using VBA

Dim strCurrentFileExt   As String
Dim strNewFileExt       As String
Dim objFSO              As Object
Dim objFolder           As Object
Dim objFile             As Object
Dim xlFile              As Workbook
Dim strNewName          As String
Dim strFolderPath       As String

strCurrentFileExt = ".xls"
strNewFileExt = ".xlsx"

strFolderPath = "C:\myExcelFolders"
If Right(strFolderPath, 1) <> "\" Then
    strFolderPath = strFolderPath & "\"
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strFolderPath)
For Each SubFolder In objFolder.SubFolders
  For Each objFile In objFolder.Files
    strNewName = objFile.Name
    If Right(strNewName, Len(strCurrentFileExt)) = strCurrentFileExt Then
        Set xlFile = Workbooks.Open(objFile.Path, , True)
        strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
        Application.DisplayAlerts = False
        Select Case strNewFileExt
        Case ".xlsx"
            xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbook
        Case ".xlsm"
            xlFile.SaveAs strFolderPath & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
        End Select
        xlFile.Close
        Application.DisplayAlerts = True
    End If
  Next objFile
Next