Excel 仅在第二次运行时崩溃

我试图使一个excel表格，我可以控制VBA代码使用共享点列表。 因此，我将代码脚本上传到共享点列表中，当打开excel时，宏开始下载。 我听说使用VBA编辑VBA不是很推荐，但现在我相信这是我能想到的唯一选择。因为这是为了我的工作，所以我只能有限地访问互联网和应用程序。（需要管理员批准）

我的代码序列是

删除所有VB代码

向每个VB组件插入代码脚本

问题是

当我第一次运行代码（第一次运行）时，大多数情况下它运行良好。但当我第二次运行（第二次运行）时，它崩溃了，excel本身被冻结，没有任何错误消息。我不明白它第一次起作用了

当我单独运行代码时，它总是运行良好

请看一看，如果你能给我任何解决这个问题的想法，我将不胜感激

我尝试在两个过程之间插入“Wait”，但结果相同。第一次运行-正常，第二次运行-失败（无错误/excel冻结）

Private子调用过程（）
呼叫清除旧的VBC
调用加载模块
端接头
私人分机清除旧的VBCs（）
将VBC设置为VBC组件
作为vbC组件的Dim vbC
application.ScreenUpdating=False
设置vbCs=ThisWorkbook.VBProject.VBComponents
'启动前清除代码
对于vbCs中的每个vbC
如果LCase（vbC.Name）=LCase（“此工作簿”），则
'Debug.Print Now，vbC.Name，vbC.Type，“跳过！”
其他的
'Debug.Print Now，vbC.Name，vbC.Type，“删除代码！”
vbC.CodeModule.DeleteLines 1，vbC.CodeModule.CountOfLines
如果结束
下一个vbC
设置vbC=Nothing
设置vbCs=Nothing
application.ScreenUpdating=True
端接头
专用子加载_模块（）
将rs设置为新ADODB.Recordset
Dim strSQL，strConn作为字符串
Dim strSP、strList、strListID作为字符串
将VBC设置为VBC组件
Dim vbCode作为代码模块
Dim ParentName、ParentType、strScript、strVersion、strScript ID作为字符串
作为布尔值的Dim boolStatus
Dim cnt，iLen，i，j作为整数
Dim TIME修改为日期
application.ScreenUpdating=False
strSP=“XXXXXXX”'Sharepoint URL/由于公司政策，我无法透露此信息
strList=“模块脚本””Sharepoint列表名称
strListID=“XXXXXXXX”'Sharepoint列表ID/由于公司政策，我无法透露此信息
strConn=“Provider=Microsoft.ACE.OLEDB.12.0；WSS；IMEX=0；RetrieveIds=Yes；DATABASE=“&strSP&”LIST=“&strListID&；”
strSQL=“从“&”[“&strList&”]”和中选择[Script ID]、[Script]、[Parent Name]、[Parent Type]、[Active Version]、[Script Status]、[Modified]_
“其中[应用程序名称]=”&“&Strap_Name&“'或[应用程序名称]=”common“&”_
“按[父项名称]订购”
rs.打开strSQL、strConn、adOpenStatic、adLockReadOnly、adCmdText
设置vbCs=ThisWorkbook.VBProject.VBComponents
直到rs.EOF=真
strScriptID=rs.Fields（“脚本ID”）.Value
strScript=rs.Fields（“脚本”）.Value
ParentName=rs.Fields（“父名称”）.Value
ParentType=rs.Fields（“父类型”）.Value
strrvision=rs.Fields（“活动版本”）.Value
boolStatus=rs.Fields（“脚本状态”）.Value
timeModified=rs.Fields（“Modified”）.值
iLen=75
如果是布尔状态，那么
如果IsParentModuleExist\u更新程序（ParentName，ParentType），则
Debug.Print Now，ParentName，ParentType，strScriptID，“存在！”
其他的
Debug.Print Now，ParentName，ParentType，strScriptID，“不存在！创建！”
调用CreateParentModule\u更新程序（ParentName，ParentType）
如果结束
如果ParentType=“工作表”，则
设置vbCode=vbCs.Item（Sheets（ParentName）.code名称）.code模块
其他的
设置vbCode=vbCs.Item（ParentName）.CodeModule
如果结束
Debug.Print Now，ParentName，ParentType，strScriptID，“代码插入！”
vbCode.InsertLines vbCode.CountOfLines+1，工作表函数.Rept（“”，iLen）
vbCode.InsertLines vbCode.CountOfLines+1，“'”和“*脚本ID:”&工作表函数.Rept（“，iLen-2-Len（“*脚本ID:”）”和“”
vbCode.InsertLines vbCode.CountOfLines+1，“'”和“*上次修改：”&工作表函数.Rept（“，iLen-2-Len（“*上次修改：）”和“”
vbCode.InsertLines vbCode.CountOfLines+1，“'”和“*当前版本：”&工作表函数.Rept（“，iLen-2-Len（“*当前版本：）”和“”
vbCode.InsertLines vbCode.CountOfLines+1，工作表函数.Rept（“”，iLen）
vbCode.InsertLines vbCode.CountOfLines+1、strScript和vbNewLine
如果结束
下一个
环
rs.Close
设置rs=无
设置vbCs=Nothing
设置vbCode=Nothing
application.ScreenUpdating=True
端接头
私有函数CreateParentModule_更新程序（ByVal ParentName作为字符串，ByVal ParentType作为字符串）
将VBC设置为VBC组件
选择案例父类型
案例“模块”、“用户表单”、“类模块”
设置vbCs=ThisWorkbook.VBProject.VBComponents
选择案例父类型
案例“模块”
vbCs.添加vbext\U ct\U标准模块
案例“用户表单”
vbCs.添加vbext\U ct\MSForm
案例“类模块”
添加vbext\U ct\U类模块
结束选择
vbCs.Item（vbCs.Count）.Name=ParentName
案例“工作表”
Worksheets.Add（后面：=工作表（Worksheets.Count））。
Private Sub CallPrcedures()

Call Clear_Old_VBCs
Call Load_Modules

End Sub


Private Sub Clear_Old_VBCs()
    Dim vbCs As VBComponents
    Dim vbC As VBComponent
    
    application.ScreenUpdating = False
    
    Set vbCs = ThisWorkbook.VBProject.VBComponents
    
    'Code Clear Before Start
    For Each vbC In vbCs
        If LCase(vbC.Name) = LCase("thisworkbook") Then
            'Debug.Print Now, vbC.Name, vbC.Type, " Skip!"
            
        Else
            'Debug.Print Now, vbC.Name, vbC.Type, " Delete Code!"
            vbC.CodeModule.DeleteLines 1, vbC.CodeModule.CountOfLines
            
            
        End If

    Next vbC
    
    Set vbC = Nothing
    Set vbCs = Nothing
    
    application.ScreenUpdating = True
    
End Sub

Private Sub Load_Modules()

    Dim rs As New ADODB.Recordset
    Dim strSQL, strConn As String
    Dim strSP, strList, strListID As String
    Dim vbCs As VBComponents
    Dim vbCode As CodeModule
    Dim ParentName, ParentType, strScript, strVersion, strScriptID As String
    Dim boolStatus As Boolean
    Dim cnt, iLen, i, j As Integer
    Dim timeModified As Date
    
    application.ScreenUpdating = False
    
    strSP = "XXXXXXX"     'Sharepoint URL / Due to company policy, I cannot reveal this information
    strList = "Module Script"   'Sharepoint List Name
    strListID = "XXXXXXXX"      'Sharepoint List ID / Due to company policy, I cannot reveal this information
    
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=" & strSP & ";LIST=" & strListID & ";"
    strSQL = "SELECT [Script ID], [Script], [Parent Name], [Parent Type], [Active Version], [Script Status], [Modified] FROM " & "[" & strList & "]" & _
            " WHERE [Application Name]=" & "'" & strApp_Name & "' OR [Application Name]='common'" & _
            " ORDER BY [Parent Name]"
        
    rs.Open strSQL, strConn, adOpenStatic, adLockReadOnly, adCmdText
    
    Set vbCs = ThisWorkbook.VBProject.VBComponents
    
    Do Until rs.EOF = True
        
        strScriptID = rs.Fields("Script ID").Value
        strScript = rs.Fields("Script").Value
        ParentName = rs.Fields("Parent Name").Value
        ParentType = rs.Fields("Parent Type").Value
        strVersion = rs.Fields("Active Version").Value
        boolStatus = rs.Fields("Script Status").Value
        timeModified = rs.Fields("Modified").Value
        
        iLen = 75
        
        If boolStatus Then
        
            If IsParentModuleExist_Updater(ParentName, ParentType) Then
                Debug.Print Now, ParentName, ParentType, strScriptID, "Exists!"
            Else
                Debug.Print Now, ParentName, ParentType, strScriptID, "Doesn't exist!, Create!"
                Call CreateParentModule_Updater(ParentName, ParentType)

            End If
            
            If ParentType = "Worksheet" Then
                Set vbCode = vbCs.Item(Sheets(ParentName).CodeName).CodeModule

            Else
                Set vbCode = vbCs.Item(ParentName).CodeModule

            End If

            Debug.Print Now, ParentName, ParentType, strScriptID, "Code Insert!"
            vbCode.InsertLines vbCode.CountOfLines + 1, WorksheetFunction.Rept("'", iLen)
            vbCode.InsertLines vbCode.CountOfLines + 1, "'" & " * Script ID : <" & strScriptID & ">" & WorksheetFunction.Rept(" ", iLen - 2 - Len(" * Script ID : <" & strScriptID & ">")) & "'"
            vbCode.InsertLines vbCode.CountOfLines + 1, "'" & " * Last Modified : <" & timeModified & ">" & WorksheetFunction.Rept(" ", iLen - 2 - Len(" * Last Modified : <" & timeModified & ">")) & "'"
            vbCode.InsertLines vbCode.CountOfLines + 1, "'" & " * Current Version : <" & strVersion & ">" & WorksheetFunction.Rept(" ", iLen - 2 - Len(" * Current Version : <" & strVersion & ">")) & "'"
            vbCode.InsertLines vbCode.CountOfLines + 1, WorksheetFunction.Rept("'", iLen)
            vbCode.InsertLines vbCode.CountOfLines + 1, strScript & vbNewLine

                
        End If

        rs.MoveNext
    
    Loop
    
    rs.Close
    
    Set rs = Nothing
    Set vbCs = Nothing
    Set vbCode = Nothing
    
    application.ScreenUpdating = True
            
End Sub

Private Function CreateParentModule_Updater(ByVal ParentName As String, ByVal ParentType As String)
    Dim vbCs As VBComponents
    
    Select Case ParentType
        Case "Module", "User Form", "Class Module"
            Set vbCs = ThisWorkbook.VBProject.VBComponents
   
            
            Select Case ParentType
                Case "Module"
                    vbCs.Add vbext_ct_StdModule
                    
                Case "User Form"
                    vbCs.Add vbext_ct_MSForm
                    
                Case "Class Module"
                    vbCs.Add vbext_ct_ClassModule
            End Select
                vbCs.Item(vbCs.Count).Name = ParentName
            
        Case "Worksheet"
            Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = ParentName
            
        Case "Workbook"
        
        Case Else
        
    End Select
        
End Function

Private Function IsParentModuleExist_Updater(ByVal ParentName As String, ByVal ParentType As String) As Boolean
    Dim vbC As VBComponent
    Dim ws As Worksheet
    
    Select Case ParentType
        Case "Module", "User Form", "Class Module"
            
            For Each vbC In ThisWorkbook.VBProject.VBComponents
                If LCase(vbC.Name) = LCase(ParentName) Then
                    IsParentModuleExist_Updater = True
                    Exit Function
                    
                End If
                        
            Next vbC
            
        Case "Worksheet"
            For Each ws In ThisWorkbook.Worksheets
                If ws.Name = ParentName Then
                    IsParentModuleExist_Updater = True
                    Exit Function
                    
                End If
                
            Next ws
            
        Case "Workbook"
        
        Case Else
        
    End Select
    
    IsParentModuleExist_Updater = False
    
End Function