VBA|使用vba代码为多个excel批量导入模块

Sub button_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 s As String
    Dim i As Integer
    Dim j As Integer

    Set fd = application.FileDialog(msoFileDialogFilePicker)
    Set fso = CreateObject("Scripting.FileSystemObject")
    i = ThisWorkbook.Sheets("filename").Cells(Rows.Count, 1).End(xlUp).Row + 1
    j = ThisWorkbook.Sheets("done").Cells(Rows.Count, 1).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)
               s = wb.VBProject.VBComponents("config").Name
               If Err Then
                   wb.application.VBE.ActiveVBProject.VBComponents.Import "D:\VBA工具\vbatools\pur_new_01\导入模块\config.bas"
                   ThisWorkbook.Sheets("done").Range("a" & j).Value = strFolder
                   j = j + 1
               Else:
                   ThisWorkbook.Sheets("filename").Range("a" & i).Value = strFolder
                   i = i + 1
               End If
               wb.Close True
               application.ScreenUpdating = True
           Next
        End If
    End With
    Me.TextBox1.Text = d("file_name")
    
    
   
    MsgBox "附件处理成功"
End Sub