Option Explicit
Sub xlsTOxlsx()Dim strFilePath As String, strFileName As String, strFileType As StringDim aIndex As Long, arrFileName() As String, strNewName As String
'设置文件扩展名标识文件类型strFileType = ".xls"
On Error Resume Next'设置文件夹路径strFilePath = CreateObject("shell.application").BrowseForFolder(0, "请选择文件夹", 0).self.PathIf Err <> 0 Or InStr(1, strFilePath, "::") > 0 ThenErr = 0Exit SubEnd If
'开始搜索文件strFileName = Dir(strFilePath & "*.*")Do While strFileName <> ""If LCase(Right(strFileName, Len(strFileType))) = LCase(strFileType) ThenReDim Preserve arrFileName(aIndex)arrFileName(aIndex) = strFileNameaIndex = aIndex + 1'Debug.Print strFileNameEnd IfstrFileName = DirDoEventsLoopIf aIndex = 0 Then Exit Sub
文章内容收集于网络，希望能为您提供帮助。强国说学习-WPS之家(wps.qiangguoshuo.com)
Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseFor aIndex = LBound(arrFileName) To UBound(arrFileName)strNewName = Mid(arrFileName(aIndex), 1, Len(arrFileName(aIndex)) - Len(strFileType)) & ".xlsx"Workbooks.Open strFilePath & arrFileName(aIndex)ActiveWorkbook.SaveAs Filename:=strFilePath & strNewName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=FalseWorkbooks(strNewName).Close False '关闭工作簿Kill strFilePath & arrFileName(aIndex)DoEventsNextApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueMsgBox "操作完成，共为您转换了 " & UBound(arrFileName) + 1 & " 个文件。", vbOKOnly, "完成"End Sub
转载声明：本站发布文章及版权归原作者所有，转载本站文章请注明文章来源！
