Vba vbDestComps=vbDestProj.VBComponents 对于vbDestComps中的每个vbDestComp 如果vbDestComp.Type>=1且vbDestComp.Type，删除目标中的所有组件，然后从源中复制所有组件不是更简单

vbDestComps=vbDestProj.VBComponents 对于vbDestComps中的每个vbDestComp

---

如果vbDestComp.Type>=1且vbDestComp.Type，删除目标中的所有组件，然后从源中复制所有组件不是更简单吗？（而不是从源代码复制到目标代码并尝试进行排序）为什么需要向后运行编号循环，并按编号引用组件？你能不能先对每个都做一个检查，然后检查每个vbDestComp.Name？看起来您是在注释行中开始这样做的。出了什么问题？您需要测试

VBComponent。键入
-它包括工作簿和工作表组件。我不完全确定当您尝试删除
vbext\u ct\u文档的组件时会抛出什么，但我猜这不会很好…请参阅本文中有关删除VBA组件的答案：我看不到任何错误消息的引用？在这些情况下，“不起作用”是什么意思？
    Sub UpdateDest()
    'Purpose:
    'Sources: (1) https://www.excel-easy.com/vba/examples/import-sheets.html
    '         (2) https://stackoverflow.com/questions/16174469/unprotect-vbDestProject-from-vb-code
    '         (3) https://stackoverflow.com/questions/18497527/copy-vba-code-from-a-sheet-in-one-workbook-to-another

    '=== Declare Variables
        Dim booCompFound As Boolean
        Dim cmSrc As CodeModule, cmDest As CodeModule
        Dim xlWBDest As Excel.Workbook, xlWSDest As Excel.Worksheet
        Dim xlWBSrc As Excel.Workbook, xlWSSrc As Excel.Worksheet
        Dim i As Integer, j As Integer
        Dim lngVBUnlocked As Long
        Dim vbDestComp As Object, vbDestComps As Object, vbDestProj As Object, vbDestMod As Object
        Dim vbSrcComp As Object, vbSrcComps As Object, vbSrcProj As Object, vbSrcMod As Object
        Dim modModule As Object
        Dim strDestName As String, strDestPath As String, strSrcName As String, strSrcPath As String
        Dim strUpdName As String, strUpdPath As String

        'On Error GoTo ErrorHandler
    '=== Initialize Variables and Prepare for Execution
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        strUpdPath = ThisWorkbook.Path & "\"

    '=== (Code execution)
        '--- Select Dest and source workbooks for the update, and remove workbook, worksheet and VBA Project protection from both
        strSrcPath = Application.GetOpenFilename(Title:="Select SOURCE workbook for the update", FileFilter:="Excel Files *.xls* (*.xls*),")
        If strSrcPath = "" Then
            MsgBox "No source workbook was selected.", vbExclamation, "Sorry!"
            Exit Sub
        Else
            Set xlWBSrc = Workbooks.Open(strSrcPath)
            UnprotectAll xlWBSrc
            'For Each xlWSSrc In xlWBSrc.Worksheets
            '    xlWSSrc.Visible = xlSheetVisible
            'Next xlWSSrc
            Set vbSrcProj = xlWBSrc.VBProject
            lngVBUnlocked = UnlockProject(vbSrcProj, "FMD090")
            Debug.Print lngVBUnlocked
            If lngVBUnlocked <> 0 And lngVBUnlocked <> 2 Then
                MsgBox "The source VB Project could not be unlocked.", vbExclamation, "Error!"
                Exit Sub
            Else
                Set vbSrcComps = vbSrcProj.VBComponents
            End If
        End If
        strDestPath = Application.GetOpenFilename(Title:="Select DESTINATION workbook to update", FileFilter:="Excel Files *.xls* (*.xls*),")
        If strDestPath = "" Then
            MsgBox "No destination workbook was selected.", vbExclamation, "Sorry!"
            Exit Sub
        Else
            Set xlWBDest = Workbooks.Open(strDestPath)
            UnprotectAll xlWBDest
            'For Each xlWSDest In xlWBDest.Worksheets
            '    xlWSDest.Visible = xlSheetVisible
            'Next xlWSDest
            Set vbDestProj = xlWBDest.VBProject
            lngVBUnlocked = UnlockProject(vbDestProj, "FMD090")
            Debug.Print lngVBUnlocked
            If lngVBUnlocked <> 0 And lngVBUnlocked <> 2 Then
                MsgBox "The destination VB Project could not be unlocked.", vbExclamation, "Error!"
                Exit Sub
            Else
                Set vbDestComps = vbDestProj.VBComponents
            End If
        End If

        '--- Add components from source that are not found in destination
        For Each vbSrcComp In vbSrcComps

            Debug.Print vbSrcComp.Name
            booCompFound = False
            For Each vbDestComp In vbDestComps

                If vbSrcComp.Name = vbDestComp.Name Then
                    booCompFound = True
                    Exit For
                End If

            Next vbDestComp
            If booCompFound = False Then
                Application.EnableEvents = False
                vbSrcComp.Export strSrcPath & vbSrcComp.Name
                vbDestComps.Import strSrcPath & vbSrcComp.Name
                Kill strSrcPath & vbSrcComp.Name
                Application.EnableEvents = True
            End If

        Next vbSrcComp

        '--- Delete components in destination that are not found in source
        Set vbDestComps = vbDestProj.VBComponents
        For i = vbDestComps.Count To 1 Step -1
        'For Each vbDestComp In vbDestComps

            booCompFound = False
            For Each vbSrcComp In vbSrcComps

                Debug.Print "Src: "; vbSrcComp.Name; " Dest: "; vbDestComps(i).Name
                If vbDestComps(i).Name = vbSrcComp.Name Then
                    booCompFound = True
                    Exit For
                End If

            Next vbSrcComp
            If booCompFound = False Then
                Application.EnableEvents = False

    '>>> PROBLEM LINE
                vbDestProj.VBComponents.Remove vbDestComps(i)
    '<<<

                Application.EnableEvents = True
            End If

        'Next vbDestComp
        Next i

        '--- Replace worksheet(s) with newer versions
        strUpdName = "Lists_WS_3_1.xlsx"
        If Dir(strUpdPath & strUpdName) <> "" Then
            Application.EnableEvents = False
            Set xlWBSrc = Workbooks.Open(strUpdPath & strUpdName)
            xlWBDest.Worksheets("Lists").Visible = xlSheetVisible
            Application.DisplayAlerts = False
            xlWBDest.Worksheets("Lists").Name = "Lists_Old"
            xlWBSrc.Worksheets("Lists").Copy After:=xlWBDest.Worksheets("FYMILES")
            xlWBDest.Worksheets("Lists_Old").Delete
            xlWBSrc.Close
            Application.EnableEvents = True
        Else
            MsgBox "The file " & strUpdName & " is missing.", vbExclamation, "File Missing!"
            Exit Sub
        End If

        '--- Globally update code in modules, class modules and user forms
        For Each vbSrcComp In vbSrcComps

            Set cmSrc = vbSrcComp.CodeModule
            Debug.Print vbSrcComp.Name
            Set cmDest = vbDestComps(vbSrcComp.Name).CodeModule
            If cmSrc.CountOfLines > 0 Then
                Application.EnableEvents = False
                cmDest.DeleteLines 1, cmDest.CountOfLines  'Delete all lines in Dest component
                cmDest.AddFromString cmSrc.Lines(1, cmSrc.CountOfLines)  'Copy all lines from source component to Dest component
                Application.EnableEvents = True
            End If

        Next vbSrcComp

        '--- Update miscellaneous cell formulas and values
        Application.EnableEvents = False
        xlWBDest.Sheets("Inventory Data and July").Range("E2").Formula = "=TEXT(Lists!$O$5, " & Chr(34) & "000" & Chr(34) & ")"
        Application.EnableEvents = True

    '=== Error Handling
    ErrorHandler:
        Application.EnableEvents = True

    '=== Release Variables and Cleanup
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

    End Sub

    '--- Delete non-document components in destination that are not found in source
    Set vbDestComps = vbDestProj.VBComponents
    For Each vbDestComp In vbDestComps

        If vbDestComp.Type >= 1 And vbDestComp.Type <= 3 Then
            booCompFound = False
            For Each vbSrcComp In vbSrcComps

                Debug.Print "Src: "; vbSrcComp.Name; " Dest: "; vbDestComp.Name; " Type: "; vbDestComp.Type
                If vbDestComp.Name = vbSrcComp.Name Then
                    booCompFound = True
                    Exit For
                End If

            Next vbSrcComp
            If booCompFound = False Then
                Application.EnableEvents = False
                vbDestProj.VBComponents.Remove vbDestComp
                Application.EnableEvents = True
            End If
        End If

    Next vbDestComp