使用 VBA 将 .xls 批量转换为 .xlsx，无需打开工作簿

Batch convert .xls to .xlsx with VBA without opening the workbooks

提问by Tobias Kloss

I have a bunch of Excel-Workbooks in the old .xlsformat. I'd like to convert them to .xlsxusing VBA. The following code accomplishes this task but it needs to open each workbook in order to save it again.

我有一堆旧.xls格式的 Excel 工作簿。我想将它们转换为.xlsx使用 VBA。以下代码完成此任务，但需要打开每个工作簿才能再次保存。

Dim wbk As Workbook
Set wbk = Workbooks.Open(filename:="C:\some\example\path\workbook.xls")
wbk.SaveAs filename:="C:\some\example\path\workbook.xlsx", _
FileFormat:=xlOpenXMLWorkbook, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
wbk.Close SaveChanges:=False

Is there another way to do this task without the need to open each workbook? This is very time consuming with at least 30-100 workbooks.

是否有另一种方法无需打开每个工作簿即可完成此任务？这对于至少 30-100 个工作簿非常耗时。

回答by Arya

Here is the piece of code to get what you are looking for:

下面是一段代码来获得你正在寻找的东西：

Sub ChangeFileFormat()

    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:\Users\Scorpio\Desktop\New folder"
    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

ClearMemory:
    strCurrentFileExt = vbNullString
    strNewFileExt = vbNullString
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
    Set xlFile = Nothing
    strNewName = vbNullString
    strFolderPath = vbNullString
End Sub

this is the link for XL file format : https://msdn.microsoft.com/en-us/library/office/ff198017.aspx

这是 XL 文件格式的链接：https: //msdn.microsoft.com/en-us/library/office/ff198017.aspx

'-----------------------------------------

'-----------------------------------------

A bit Modification:Check this code, i have only changed its extension name, but please check it with the compatibility... and let me know is it working for you...

一点修改：检查这个代码，我只改变了它的扩展名，但请检查它的兼容性......让我知道它是否适合你......

Sub ChangeFileFormat_V1()

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

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

    strFolderPath = "C:\Users\Scorpio\Desktop\New folder"
    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
            strNewName = Replace(strNewName, strCurrentFileExt, strNewFileExt)
            Application.DisplayAlerts = False
            objFile.Name = strNewName
            Application.DisplayAlerts = True
        End If
    Next objFile

ClearMemory:
    strCurrentFileExt = vbNullString
    strNewFileExt = vbNullString
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
    Set xlFile = Nothing
    strNewName = vbNullString
    strFolderPath = vbNullString
End Sub