VBA|使用代码批量替换或添加代码以及导入模块

Sub CommandButton1_Click()
    On Error Resume Next
    Dim fd As FileDialog, it
    Dim fso As Object
    Dim file_name As String
    Dim strFolder As String
    Dim wb As Workbook
    Dim i As Integer
    Dim code
    Dim str1 As String
    Dim stra As String
    Dim codestr As String
    Dim num As Long
    Dim newstr As String
    str1 = "original"
    stra = "new"
    
    Set fd = application.FileDialog(msoFileDialogFilePicker)
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    With fd
         .AllowMultiSelect = True
        If .Show = -1 Then
           For Each it In .SelectedItems
               file_name = fso.GetFileName(it)
               strFolder = it
               
               application.ScreenUpdating = False
               Set wb = Workbooks.Open(strFolder)
               For Each code In wb.VBProject.VBComponents
                   Debug.Print code.Name
                   num = code.codemodule.CountOfLines
                   For i = 1 To num
                       codestr = code.codemodule.Lines(i, 1)
                       If InStr(codestr, str1) Then
                           Debug.Print codestr
                           newstr = replace(codestr, str1, stra, 1)
                           code.codemodule.DeleteLines i
                           code.codemodule.InsertLines i, newstr
                       End If
                   Next i
               Next
               wb.Close True
               application.ScreenUpdating = True
           Next
        End If
    End With
    MsgBox "附件处理成功"
End Sub

Sub CommandButton1_Click()
    On Error Resume Next
    Dim fd As FileDialog, it
    Dim fso As Object
    Dim file_name As String
    Dim new_dir As String
    Dim strFolder As String
    Dim wb As Workbook
    Dim d  As Object
    Set d = CreateObject("scripting.dictionary")
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer


    Set fd = application.FileDialog(msoFileDialogFilePicker)
    Set fso = CreateObject("Scripting.FileSystemObject")
    j = ThisWorkbook.Sheets("filename").Cells(Rows.Count, 2).End(xlUp).Row + 1
    k = ThisWorkbook.Sheets("done").Cells(Rows.Count, 2).End(xlUp).Row + 1
    With fd
         .AllowMultiSelect = True
        If .Show = -1 Then
           For Each it In .SelectedItems
               file_name = fso.GetFileName(it)
               d("file_name") = d("file_name") & file_name & ","
               strFolder = it
               d("strFolder") = d("strFolder") & strFolder & ","
               application.ScreenUpdating = False
               Set wb = Workbooks.Open(strFolder)
               i = wb.VBProject.VBComponents("Thisworkbook").codemodule.ProcStartLine("Workbook_Open", 0)
               Debug.Print i
               If i = 0 Then
                    wb.VBProject.VBComponents("Thisworkbook").codemodule.AddFromString _
                    "Private Sub Workbook_Open()" & Chr(10) & _
                    "End Sub"
                    '在此处添加代码段
                    ThisWorkbook.Sheets("done").Range("b" & k).Value = strFolder
                    k = k + 1
                Else:
                    ThisWorkbook.Sheets("filename").Range("b" & j).Value = strFolder
                    j = j + 1
                End If
                wb.Close True
                application.ScreenUpdating = True
            Next
        End If
    End With
    Me.TextBox1.Text = d("file_name")
    MsgBox "附件处理成功"
End Sub

Private Sub Workbook_Open()
    Dim s As String
    Dim arr
    Dim brr
    Dim i As Integer
    On Error Resume Next
    arr = Split("aa.bas,bb.bas,cc.cls,ee.bas,ff.bas", ",")
    '将模块名写入数组arr
    For i = 0 To UBound(arr)
        brr = Split(arr(i), ".")
        '取模块名字
        s = ThisWorkbook.VBProject.VBComponents(brr(0)).Name
        If Err Then
            ThisWorkbook.application.VBE.ActiveVBProject.VBComponents.Import "module\" & arr(i)
            Debug.Print "成功添加" & brr(0) & "模块"
            '模块存放地址
        Else:
            ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(brr(0))
            ThisWorkbook.application.VBE.ActiveVBProject.VBComponents.Import "module\" & arr(i)
            Debug.Print "成功替换" & brr(0) & "模块"
        End If
    Next i
    Debug.Print "导入成功！"
End Sub