excel-vba - excel VBA批量转换. xls 到. xlsx,不打开工作簿

  显示原文与译文双语对照的内容
117 3

我有很多excel工作簿的旧 .xls 格式。我想使用VBA将它们转换为 .xlsx下面的代码完成这里任务,但需要打开每个工作簿才能再次保存。

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

是否有其他方法来完成这里任务而不需要打开每个工作簿?这是非常耗时的至少 30 -100工作簿。

时间:原作者:0个回答

135 2

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

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:UsersScorpioDesktopNew 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:UsersScorpioDesktopNew 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
原作者:
...