gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-02 10:27:31 24 4
gpt4 key购买 nike

我有一堆旧 .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 个工作簿,这非常耗时。

最佳答案

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

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

关于excel - 使用 VBA 将 .xls 批量转换为 .xlsx,无需打开工作簿,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/29167539/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com