VBA: 使用递归法将xls文件批量转化为xlsm文件

Option Explicit

Private Sub CommandButton6_Click()

    '修改文件夹路径

    With Application.FileDialog(filedialogtype:=msoFileDialogFolderPicker)
    
        .InitialFileName = "E:\报告模板"             '设置起始目录
        .AllowMultiSelect = True                    '单选
        .Title = "请选新的文件夹路径"               '设置对话框标题
        .Show                                       '显示对话框
        
        If .SelectedItems.Count > 0 Then
        
            TextBox1.Text = .SelectedItems(1)       '将选中的文件夹路径添加到文本框
            
        Else
        
            MsgBox "没有选择目录！"
            
        End If
        
    End With

End Sub

Private Sub CommandButton8_Click()

    '批量转化

    Dim folder As String
    
    Dim fso As Object, fld As Object
    
    Dim time_ini As Date
    
    '1 准备工作
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    time_ini = Timer
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '2 遍历文件夹
    folder = TextBox1.Text
    If fso.FolderExists(folder) Then
    
        Set fld = fso.GetFolder(folder)
        
        LookUpAllFiles fld
        
    Else
    
        MsgBox folder & "文件夹路径不存在，请确认！"
        
    End If
    
    MsgBox "Done!  " & vbCrLf & vbCrLf & "用时：" & Format(Timer - time_ini, "0.0s")
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    Exit Sub

End Sub

Sub LookUpAllFiles(fld As Variant)

    '遍历xls文件
    Dim fil, outFld
    
    For Each fil In fld.Files
    
        If fil.Name Like "*.xls" Then
        
            ConvertFile fld & "\" & fil.Name
        
        End If
    
    Next
    
    For Each outFld In fld.subFolders
    
        LookUpAllFiles outFld       '递归法，调用自身
    
    Next

End Sub

Sub ConvertFile(filepath As String)

    '将xls文件转化为xlsm文件
    Dim sName As String
    
    With Workbooks.Open(filepath)
    
        sName = Dir(filepath & "m")
        If Len(sName) Then
    
            MsgBox filepath & "m" & vbCrLf & vbCrLf & "同名文件已存在，本批次结束后请确认！"
        
        Else
    
            .SaveAs Filename:=filepath & "m", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            
        End If
        
        '关闭工作簿
        .Close SaveChanges:=False
    
    End With
    
    '删除xls文件
    Kill filepath
                          
End Sub

Private Sub UserForm_Initialize()

    '窗口初始化
    TextBox1.Text = "E:\报告模板"

End Sub