使用VBA实现xls批量转xlsx

in 编程

我用Office 2019编辑过的一批xls文件,在Office 2010下无法打开,但另存为xlsx后可以,所以需要将xls批量转换为xlsx。

此时,我的逗比同事要去抖音给我搜教程……

在不借助第三方工具的情况下,使用Excel内置的VBA即可实现功能。

首先,打开VBA编辑器:

  1. 菜单栏开发工具→Visual Basic

    若菜单栏没有开发工具,则在菜单栏下方的功能区右键,选择「自定义功能区」,弹出新窗口中,在右侧勾选「开发工具」即可。

  2. 快捷键:Alt + F11

然后,在VBA编辑器中粘贴以下代码:

'***********访问当前文件夹下所有子文件夹及文件,
Dim iFile(1 To 100000) As String
Dim count As Integer
Sub xls2xlsx()
    iPath = ThisWorkbook.Path
    On Error Resume Next
    count = 0
    zdir iPath
    For i = 1 To count
        If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
            MyFile = iFile(i)
            FilePath = Replace(MyFile, ".xls", ".xlsx")
            If Dir(FilePath, 16) = Empty Then
                Set WBookOther = Workbooks.Open(MyFile)
                Application.ScreenUpdating = False
                ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                WBookOther.Close SaveChanges:=False      '解决不能close 文件问题
                Application.ScreenUpdating = True
            End If
        '注意:如果不想保留原xls文件,则把下面语句的注视去掉(删掉前面的「’」即可)
        'Kill (MyFile)
        End If
    Next
End Sub
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

最后,点击上方的运行(F5)。

注意:

  1. 以上代码默认不删除原文件,执行完后,目录下会同时存在File.xls和File.xlsx,如果不想保留,则把21行:Kill(Myfile)前的注释去掉;
  2. 如果想批量将xlsx转换为xls,则把12行代码替换为:FilePath = Replace(MyFile, ".xlsx", ".xls")即可。
Responses