office2010批量复制VBA代码到不同 *.xlsm的ThisWorkbook中

wqsk001

求助论坛的各位大大，新人小白因工作需要，求助office2010批量复制VBA代码到扩展名为 *.xlsm文件的ThisWorkbook中，最好给个附件例程，谢谢！

SCL5801

参考一下这个
http://club.excelhome.net/thread-1309116-2-1.html

wqsk001

Sub Update()
    Dim F
    Dim Cl As Object
    Dim I As Long, N As Long
    Dim Ar() As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False    '防止open close 等事件触发
    '*****************************************************************
    '获取新代码
    ReDim Ar(ThisWorkbook.VBProject.VBComponents.Count, 2)
    For Each Cl In ThisWorkbook.VBProject.VBComponents
        If m.Name <> "Update" Then  '不读取本模块代码
            Ar(N, 1) = Cl.Name
            Ar(N, 2) = Cl.CODEMODULE.Lines(1, Cl.CODEMODULE.COUNTOFLINES)
            N = N + 1
        End If
    Next
    '*****************************************************************
    '获取待更新文件
    F = Application.GetOpenFilename("Excel(*.xls*),*.xls*", , "选择要更新的文件", , False)
    If F = False Then Exit Sub
    '*****************************************************************
    '打开待更新文件，删除旧代码，写入新代码
    With Workbooks.Open(F)
        With .VBProject
            For I = 0 To N - 1
                Set Cl = Nothing
                Set Cl = .VBComponents(Ar(I, 1))
                If Not Cl Is Nothing Then
                    With Cl.CODEMODULE
                        .DELETELINES 1, .COUNTOFLINES
                        .ADDFROMSTRING Ar(I, 2)
                    End With
                End If
            Next
        End With
    '*****************************************************************
    ' XLSX 文件需要另存为启用宏的工作表 XLSM 格式
        If UCase(Right(F, 4)) = "XLSX" Then
            .SaveAs Left(F, Len(F) - 5), 52
            'Kill F   '删除 XLSX 格式原文件
       Else
            .Save
        End If
        .Close True
    End With
    Application.EnableEvents = True
End Sub
这个代码要手工选择需要更新的代码文件。经测试是成功的。我一次性要改个大几十个这样的文件，太麻烦了。我把要改的文件放到一个文件夹里，这个文件夹还有子目录。能不能请高手帮着改一下代码，一次性完成所有目录下包括子目录文件的代码更新，谢谢大家了