用VBA将xml格式的excel另存为xlsx

Posted 2022-06-08 詩和遠方

需求背景

需要将从数据库提取的数据交给用户，由于数据量较大（好几十万行），若导出为有固定分隔符的文本文件给用户，一来体验上不太好，二来若文本字符和分隔符号相同可能会出问题。于是想导出为Excel，若行数超出Excel行数限制，可拆分为多份再导出。

但由于工具限制，软件无法直接导出为Excel格式，但可导出Excel XML Spreadsheet，后缀名为xml，Excel可直接打开。

后面想更进一步，将导出的xml文件打开后另存为正常的xlsx格式再给用户，但如果导出的文件很多，一个个打开再另存，比较繁琐，于是想有无办法自动将那些xml批量另存为xlsx。

解决办法

本来想用python解决，但网上找资料发现很多都是去解析xml再写到excel，代码量大而且消耗太多内存，速度也不快。理想方案应该是充分利用excel本身的功能，模拟直接打开xml后再另存为xlsx的这个过程。最后发现还是VBA合适，毕竟专为office而生，具体参考代码如下：

Public Sub ConvertXmlToXlsx()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

xmlFolder = "D:\\Users\\Documents\\Temp\\Working\\xml\\"
convFolder = "D:\\Users\\Documents\\Temp\\Working\\xls\\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(xmlFolder)
For Each objFile In objFolder.Files
    If UCase(Right(objFile.Name, Len(XML))) = UCase(XML) Then
        NewFileName = convFolder & Left(objFile.Name, Len(objFile.Name) - 4) & ".xlsx"
        Set ConvertThis = Workbooks.Open(objFolder & "\\" & objFile.Name)
        ConvertThis.SaveAs Filename:=NewFileName, FileFormat:=xlOpenXMLWorkbook
        ConvertThis.Close
    End If
Next objFile
End Sub

VBA运行方法

新建一个Excel，按ALT+F11调出 VBA编辑器，菜单：插入->模块，然后贴上脚本，修改相关路径等，然后运行即可。
另外，上述脚本将xml改为xls后，应该还可以实现批量将xls转为xlsx的功能。

参考资料：https://stackoverflow.com/questions/38587755/convert-xml-file-to-xlsx-file-with-vba