使用VBA批量转换Excel格式,由.xls转换成.xlsx

问题分析:

  Excel2007以前的格式是.xls,之后的格式是.xlsx。打开单独的一个Excel文档,使用“另存为”功能,可以很轻松的转换格式。但是面对几百个Excel表这样就太累了,搜索很久,也没发现一个工具可以直接批量进行格式转换。

  最终发现可以使用VBA来实现批量转换Excel格式的功能。大家不要被吓到,VBA我也不懂,代码是从别人那里搞到的,现在也只是知道了怎么使用,但这足够解决问题了

VBA介绍:
  1、VBA是一种编程语言,它依托于Office软件,不能独立的运行,通过VBA可以实现各种Office软件操作的自动化。
  2、Visual Basic for Applications(VBA)是Visual Basic的一种宏语言,主要能用来扩展Windows的应用程式功能。使用Excel的VBA开发的Excel文档,在Excel中运行时需要开启Excel的宏功能,否则此文档的VBA自动化功能将被完全屏蔽,文档的功能无法实现。

执行条件:
  1、Office2007及以上版本的Excel
  2、Excel启用宏

工具下载:
  可以自己新建Excel,编写VBA代码,代码在后面。也可以使用我提供的已经写好的两个,以下是百度网盘中的链接:
    《xls2xlsx.xlsm
    链接:http://pan.baidu.com/s/1mit3FGc 密码:s57a
    《Convert2xlsx.xlsm
    链接:http://pan.baidu.com/s/1sluFttb 密码pguv

  分享的内容无法访问了,百度网盘有点小坑啊,不过代码就是下边贴出来的那些,手动粘贴吧...

功能介绍:
  先介绍这两个工具功能,大家可以根据需要下载。
  《xls2xlsx.xlsm》会在所在文件夹目录中、包括子目录中,遍历所有.xls格式的文件,执行“另存为”操作,然后在原文件当前位置另存为一个同名的.xlsx格式的文件。
  比如:执行前xls2xlsx.xlsm所在的文件夹中有3个.xls格式的文件,同时包含一个子文件夹,子文件夹中也有3个.xls格式的文件

         

  执行后,会生成如下文件:

         

  《Convert2xlsx.xlsm》会在所在文件夹目录中(不包括子目录),遍历所有.xls格式的文件,执行“另存为”操作,然后在当前路径下生成一个文件夹xlsx,这个文件夹中放了所有新生成的文件。
  比如:执行前Convert2xlsx.xlsm所在的文件夹中有3个.xls格式的文件

    

  执行后,会生成如下文件:

        

执行方法:
  1、从上面下载任意一个工具,或者新建一个Excel;
  2、启用宏操作
  一般情况下,打开Excel的时候,会弹出如下警告

    

  如果弹出了这个警告,直接启用就可以了;如果没有出现的话,请参考以下百度经验启用宏http://jingyan.baidu.com/article/39810a23e39b9db637fda651.html
  3、编写执行VBA代码
  这一步新手肯定是不会的,详细地图文介绍就参考百度经验http://jingyan.baidu.com/article/09ea3ede265e8bc0aede39ba.html,我这里只作简单的说明:
    (a)在工作表界面按下组合快捷键Alt+F11或者右键单击任意一个工作表标签,在弹出的右键快捷菜单单击“查看代码”进入VBA编辑环境
    (b)如果是下载的我的工具,可以跳过此步骤;如果是新建的Excel,此时在VBA编辑环境中的“代码窗口”复制粘贴以下两个代码中的一个:
    《xls2xlsx.xlsm》

 1 '***********访问当前文件夹下所有子文件夹及文件,
 2 Dim iFile(1 To 100000) As String
 3 Dim count As Integer
 4 
 5 Sub xls2xlsx()
 6     iPath = ThisWorkbook.Path
 7     On Error Resume Next
 8     count = 0
 9     zdir iPath
10     For i = 1 To count
11         If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
12             MyFile = iFile(i)
13             FilePath = Replace(MyFile, ".xls", ".xlsx")
14             If Dir(FilePath, 16) = Empty Then
15                 Set WBookOther = Workbooks.Open(MyFile)
16                 Application.ScreenUpdating = False
17                 ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
18                 WBookOther.Close SaveChanges:=False      '解决不能close 文件问题
19                 Application.ScreenUpdating = True
20             End If
21         End If
22     Next
23 End Sub
24 
25 Sub zdir(p)       '访问当前文件夹下所有子文件夹及文件
26   Set fs = CreateObject("scripting.filesystemobject")
27   For Each f In fs.GetFolder(p).Files
28     If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
29   Next
30   For Each m In fs.GetFolder(p).SubFolders
31       zdir m
32   Next
33 End Sub

    《Convert2xlsx.xlsm》

 1 Sub xls2xlsx()
 2 Dim FilePath, MyFile, iPath, Name, OutPath As String
 3 iPath = ThisWorkbook.Path
 4 OutPath = Dir(iPath & "xlsx", vbDirectory)
 5 If OutPath = "" Then
 6     MkDir (iPath & "xlsx")
 7 End If
 8 MyFile = Dir(iPath & "*.xls")
 9 
10 If MyFile <> "" Then
11 Do
12     On Error Resume Next
13     If MyFile = ThisWorkbook.Name Then MyFile = Dir
14     Workbooks.Open (iPath & "" & MyFile)
15     MyFile = Replace(MyFile, ".xls", ".xlsx")
16     Name = "" & MyFile
17     FilePath = iPath & "xlsx" & Name
18     Application.ScreenUpdating = False
19     ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
20     Workbooks(MyFile).Close True
21     Application.ScreenUpdating = True
22     MyFile = Dir
23 Loop While MyFile <> ""
24 End If
25 End Sub

    (c)按下F5快捷键执行这段代码或者在菜单中单击“运行子过程/用户窗体”命令

  PS:需要说明的是,在执行过程中,不要去做其他的事情,不然可能会中断程序的运行


  后来有同学提了些问题,最后执行代码的时候,并没有达到效果。先来看下正常的效果,会先弹出一个对话框,然后运行

  出问题的原因是:在文件夹中的 .xls的后缀是大写的。这导致了代码不能执行,不过这种情况稍微修改下就可以了

  我还试了一下,如果同目录下 .xls 和 .xlsx同时存在,也执行不了……

  原创文章,欢迎转载,转载请注明出处!

原文地址:https://www.cnblogs.com/acm-bingzi/p/6679235.html