excel VBA将一个目录下的所有xls文件批量转换为xlsx文件
时间:2022-08-19 04:46:05
Option Explicit
Sub xlsTOxlsx()
Dim strFilePath As String, strFileName As String, strFileType As String
Dim aIndex As Long, arrFileName() As String, strNewName As String
'设置文件扩展名标识文件类型
strFileType = ".xls"
On Error Resume Next
'设置文件夹路径
strFilePath = CreateObject("shell.application").BrowseForFolder(0, "请选择文件夹", 0).self.Path
If Err <> 0 Or InStr(1, strFilePath, "::") > 0 Then
Err = 0
Exit Sub
End If
'开始搜索文件
strFileName = Dir(strFilePath & "*.*")
Do While strFileName <> ""
If LCase(Right(strFileName, Len(strFileType))) = LCase(strFileType) Then
ReDim Preserve arrFileName(aIndex)
arrFileName(aIndex) = strFileName
aIndex = aIndex + 1
'Debug.Print strFileName
End If
strFileName = Dir
DoEvents
Loop
If aIndex = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For 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:=False
Workbooks(strNewName).Close False '关闭工作簿
Kill strFilePath & arrFileName(aIndex)
DoEvents
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "操作完成,共为您转换了 " & UBound(arrFileName) + 1 & " 个文件。", vbOKOnly, "完成"
End Sub
excel VBA将一个目录下的所有xls文件批量转换为xlsx文件的下载地址:
![](/images/zang.png)
![](/images/jiucuo.png)
猜你喜欢
Excel中表格添加序号和自动排序的操作方法
怎么在word上制作工作简报?word上制作工作简报的方法
![](https://img.aspxhome.com/file/2023/0/25450_0s.jpg)
不花1分钱,112套组织架构word模板,免费送你
![](https://img.aspxhome.com/file/2023/8/16928_0s.png)
如何在Excel中制作条形码
![](https://img.aspxhome.com/file/2023/8/a156148_0s.jpg)
excel 如何复制公式到相邻单元格
![](https://img.aspxhome.com/file/2023/3/a161963_0s.png)
利用Excel函数进行多条件求和
win10怎么关闭防火墙提示打游戏?win10关闭防火墙提示打游戏教程
![](https://img.aspxhome.com/file/2023/7/48407_0s.jpg)
excel表格怎样将经纬度转换
excel数据表怎么导入到数据库
excel如何制作折线图
Excel2019函数MAXIFS怎么使用?Excel2019函数MAXIFS使用教程
![](https://img.aspxhome.com/file/2023/3/40023_0s.jpg)
word中多次绘制直线,每次都要点击插入形状,很烦人!
![](https://img.aspxhome.com/file/2023/4/32374_0s.jpg)
利用word如何使彩色照片快速变为黑白照片?
![](https://img.aspxhome.com/file/2023/3/35863_0s.png)
iOS 14.5正式版值得第一时间更新吗?iOS 14.5正式版更新建议
![](https://img.aspxhome.com/file/2023/9/45979_0s.png)
Win10总弹出提示你的电脑遇到问题需要重新启动
![](https://img.aspxhome.com/file/2023/1/51931_0s.jpg)
excel表格乘法公式怎么输入
word论文排版流程
word怎么画二叉树?
![](https://img.aspxhome.com/file/2023/8/30208_0s.jpg)
word中如何制作简历
Excel 如何添加涨/跌柱线的详细步骤
![](https://img.aspxhome.com/file/2023/6/a154096_0s.jpg)