VBA实现xls批量转换为xlsx(非新增副本文件)

发布于:2023-02-19 ⋅ 阅读:(1009) ⋅ 点赞:(0)

对别人的代码做了改良,实现真正的转换而非同时存在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文件删除。

Excel xls批量转换为xlsx - MrDaoRen - 博客园 (cnblogs.com)

本文含有隐藏内容,请 开通VIP 后查看

网站公告

今日签到

点亮在社区的每一天
去签到