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

Question

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

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

是否有其他方法可以完成此任务而无需打开每个工作簿？ 对于至少 30-100 个工作簿，这非常耗时。

Answer 1

下面是获取您要查找的内容的代码:

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

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

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

一点修改: 检查此代码，我只更改了其扩展名，但请检查它的兼容性...并让我知道它是否适合您...

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