批量将xls到xlsx的vba代码
出于工作需要，自己编写了一套Python程序来提取多个不同Excel文档中特定数据到指定新Excel文档中指定位置的一个小程序。因使用到了openpyxl库，而该库只对xlsx发生作用，可实际收集到的文档是xlsx和xls的混合，当然了，告知发送人改为xlsx也不是不可以
但我还是倾向于用技术解决，幸搜寻到了一份批量将xls到xlsx的vba代码，将内置于一个新的Excel文档中，保存在文档文件夹下，运行该vba后
即可以批量将该文件夹下的多层文件夹内的xls文档另存为xlsx，避免了逐个打开后再另存为的机械动作，提高了工作效率。
'***********访问当前文件夹下所有子文件夹及文件,
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
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
页:
[1]