如何查看目录中的所有文件夹来更改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