使用VBA将.xls批量转换为.xlsx，而无需打开工作簿 [英] Batch convert .xls to .xlsx with VBA without opening the workbooks

问题描述

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

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

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份工作簿，这非常耗时.

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.

推荐答案

以下是获得所需内容的代码:

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

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

this is the link for XL file format : 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

这篇关于使用VBA将.xls批量转换为.xlsx，而无需打开工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！