对别人的代码做了改良,实现真正的转换,而非同时存在xls文件和xlsx文件。
我在大部分语句上补充了注释,因为有同事提出了这个工作需求,之前从来没接触过VBScript语言,看了别人的代码一眼过去也是看不懂,后来挨个读,边查边学就读通了。也试了Python能跑起来别人的代码,但是对小白不友好,也不可能在同事的电脑上配置这么麻烦的Python环境和pip包管理工具,最简单有效的方式就是通过VBScript来完成了。
原理:使用Kill函数,删除原来的xls文件,留下新增加的xlsx文件。
操作流程如下:
※1.在需要转换的excel所在文件夹中新建一个xlsx的excle;
※2.打开新建的Excle,文件=>选项=>信任中心=>信任中心设置=>隐私选项=>取消勾选“保存时从文件属性中删除个人信息”;
※3.按 alt+F11,选中打开左边当前Excel的Sheet;
※4.将文尾VBA代码粘贴进去,点击顶部菜单栏的运行=>运行子过程/程序编译=>运行。
全部变成xlsx了!
代码
Dim iFile(1 To 100000) As String '声明一个名为iFile的字符串类型的变量
Dim count As Integer '声明一个名为count的整型变量
'定义一个名为xls2xlsx的函数
Sub xls2xlsx()
iPath = ThisWorkbook.Path '定义iPath变量的初始值为当前工作簿的路径
On Error Resume Next
count = 0 '控制循环的变量
zdir iPath '调用zdir函数,参数为iPath
For i = 1 To count
'选择后缀名为xls的文件
If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
MyFile = iFile(i) '把iFile(i)赋值给临时变量FilePath
FilePath = Replace(MyFile, ".xls", ".xlsx") 'FilePath接收替换后的字符串
If Dir(FilePath, 16) = Empty Then '如果不路径为空
Set WBookOther = Workbooks.Open(MyFile) '根据MyFile保存的路径打开工作簿
Application.ScreenUpdating = False '禁止屏幕更新,加快宏运行速度
'当前工作簿另存为文件名:FilePath;指定保存工作表时的文件格式为xlOpenXMLWorkbook(即.xlsx扩展名);不自动备份文件
ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Kill MyFile
WBookOther.Close SaveChanges:=False '解决不能close 文件问题
Application.ScreenUpdating = True '禁止屏幕更新,加快宏运行速度
End If '结束if条件
End If '结束if条件
Next
End Sub
'定义一个名为zdir的函数
Sub zdir(p) '访问当前文件夹下所有子文件夹及文件
Set fs = CreateObject("scripting.filesystemobject")
For Each f In fs.GetFolder(p).Files
If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
Next
For Each m In fs.GetFolder(p).SubFolders
zdir m
Next
End Sub
参考文章:
这个文章的代码是把xls另存为一份xlsx,保留了xls。我的代码就是在这个基础上把原本的xls文件删除。
本文含有隐藏内容,请 开通VIP 后查看