VBA|使用vba代码批量添加vba代码

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) & _
                    "Dim section As String" & Chr(10) & _
                    "If ThisWorkbook.Path Like ""*debug_program*"" Then" & Chr(10) & _
                    "section = ""test_db""" & Chr(10) & _
                    "Else" & Chr(10) & _
                    "section = ""db""" & Chr(10) & _
                    "End If" & Chr(10) & _
                    "db_host = ReadFromIni(section, ""host"")" & Chr(10) & _
                    "db_port = ReadFromIni(section, ""port"")" & Chr(10) & _
                    "db_name = ReadFromIni(section, ""name"")" & Chr(10) & _
                    "db_user = ReadFromIni(section, ""user"")" & Chr(10) & _
                    "db_pwd = ReadFromIni(section, ""pwd"")" & 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