Excel VBA批量转换某个文件夹里的xls工作簿为xlsx

xcel VBA批量转换某个文件夹里的xls工作簿为xlsx

Sub 批量转换工作簿()

Dim oPath As String '原始文件路径

Dim oFName As String '原始文件名

Dim dPath As String '目标文件路径

Dim dFName As String '目标文件名

'获取路径

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = "C:\Users\" & Environ("username") & "\Desktop\"

If .Show = True Then Path = .SelectedItems(1) & "\"

End With

If Path = "" Then Exit Sub

oPath = Path

dPath = ThisWorkbook.Path & "\转换结果"

'打开工作簿时强制禁止宏

Application.AutomationSecurity = msoAutomationSecurityForceDisable

'禁用警告

Application.DisplayAlerts = False

'查找xls文件

oFName = Dir(oPath & "*.xls")

'当文件被找到则不断循环

Do While oFName <> ""

'打开工作簿

With Workbooks.Open(oPath & oFName)

'判断工作簿是否含有VB工程

If .HasVBProject Then

'若含有VB工程，则另存为启用宏的工作簿

dFName = oFName & "m"

.SaveAs dPath & dFName, xlOpenXMLWorkbookMacroEnabled

Else

'若不含有VB工程，则另存为一般工作簿

dFName = oFName & "x"

.SaveAs dPath & dFName, xlOpenXMLWorkbook

End If

'关闭工作簿

.Close False

End With

'查找下一个文件

oFName = Dir

Loop

'恢复打开文件的宏安全性设置

Application.AutomationSecurity = msoAutomationSecurityByUI

'启用警告

Application.DisplayAlerts = True

End Sub