如何查看目錄中的所有文件夾以更改excel文件的文件擴展名？

Question

我有很多位於不同文件夾中的.xls excel文件。我想將這些轉換爲.xlsx文件擴展名。我的代碼工作正常，如果我指定文件夾文件的位置，但我想修改它來查看目錄中的所有文件夾，並將任何.xls文件轉換爲.xlsx在一次。我很困難。這裏是我的代碼：

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 

Answer 1

參考這個（在文件夾中每個子文件夾）：

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 

編輯

如果你想深入到無限的子文件夾，然後你需要遞歸：

Function test(sPath As String) As String 

    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 

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

    If Right(sPath, 1) <> "\" Then 
     sPath = sPath & "\" 
    End If 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.getfolder(sPath) 
    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 sPath & strNewName, XlFileFormat.xlOpenXMLWorkbook 
      Case ".xlsm" 
       xlFile.SaveAs sPath & strNewName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled 
      End Select 
      xlFile.Close 
      Application.DisplayAlerts = True 
     End If 
     Next objFile 
     test = test(SubFolder.Path) 
    Next 

End Function 

Sub TestR() 

    Call test("C:\myExcelFolders") 

End Sub