VBA中的wb.Close中的Excel崩溃

Question

此代码中的所有内容均可正常工作，除非在最后关闭工作簿时执行某些操作。我将一些代码插入到工作簿的ThisWorkbook中，该工作簿将从文本文件中打开，并将主电子表格中的一些选项卡复制到我在此循环中打开的每个工作簿中。在循环结束时，当我尝试关闭并转向下一个工作簿时，它崩溃。

Sub AddSht_AddCode() 
Dim wb As Workbook 
Dim xPro As VBIDE.VBProject 
Dim xCom As Variant 
Dim xMod As VBIDE.CodeModule 
Dim xLine As Long 
Dim strFolderPath As String 
Dim strFolderPathTo As String 
Dim strCodePath As String 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objFile As Object 
Dim mergearea As Range 
Dim c As Range 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
strFolderPath = Sheets("Master - DO NOT MOVE").Range("B2").Value 

strCodePath = Sheets("Master - DO NOT MOVE").Range("b18").Value 
If IsNull(strFolderPath) Or strFolderPath = "" Then 
    MsgBox "Please make sure you have a valid DFF path entered in Cell B2 on the Master worksheet.", vbOKOnly 
    Exit Sub 
End If 

Set objFSO = CreateObject("Scripting.FileSystemObject") 

If Dir(strFolderPath, vbDirectory) = "" Then 
    MsgBox "The DFF folder path entered is not a valid path. Please edit and try again.", vbOKOnly 
    Exit Sub 
Else 
    Set objFolder = objFSO.GetFolder(strFolderPath) 
End If 

'create_projid_array 
'create_projid_new 

For Each objFile In objFolder.Files 

'If (InStr(objFile.Name, ".xlsm") > 0 Or InStr(objFile.Name, ".xlsx") > 0) And check_var_array(Left(objFile.Name, InStr(1, objFile.Name, ".") - 1), projarray) = 1 Then 
'If (InStr(objFile.Name, ".xlsx") > 0 Or InStr(objFile.Name, ".xlsb") > 0) And check_var_array(Left(objFile.Name, InStr(1, objFile.Name, ".") - 1), projarray) = 1 Then 
If (InStr(objFile.Name, ".xlsm") > 0) Then 
'If check_var_array(objFile.Name, projarray) = 1 Then 

    Application.AutomationSecurity = msoAutomationSecurityLow 
    Set wb = Workbooks.Open(objFile, False) 
    'Application.AutomationSecurity = msoAutomationSecurityByUI 

    Workbooks("DFFPHI_w_QAQC.xlsm").Activate 
    If Right(objFile.Name, 5) = ".xlsx" Then 
     Sheets(Array("Template", "Log")).Copy After:=wb.Sheets(1) 
     If Sheets("Master - DO NOT MOVE").Range("B4") = True Then 
     wb.Activate 
     wb.Sheets("Data").UsedRange.Clear 
     wb.Sheets("Data").Range("A1").Value = 0 
     Workbooks("DFFPHI_w_QAQC.xlsm").Sheets("Data").Range("B1:BO2400").Copy Destination:=wb.Sheets("Data").Range("B1") 
     End If 
    End If 

    wb.Activate 
    wb.Sheets(1).Visible = xlSheetVisible 
    wb.Sheets(1).Unprotect Password:="xxxxxxxxx" 
    Set mergearea = wb.Sheets(1).Range("i5:l6") 
    For Each c In mergearea 
    If c.MergeCells Then 
    c.UnMerge 
    End If 
    Next 
    wb.Sheets(1).Range("J5").ClearContents 
    wb.Sheets(1).Range("j6").ClearContents 
    'Selection.UnMerge 
    'Selection.ClearContents 

    If Right(objFile.Name, 5) = ".xlsm" Then 
     wb.Sheets("Template").Visible = xlSheetVisible 
     wb.Sheets("Data").Visible = xlSheetVisible 

     Workbooks("DFFPHI_w_QAQC.xlsm").Activate 
      If Sheets("Master - DO NOT MOVE").Range("B4") = True Then 
      wb.Activate 
      wb.Sheets("Data").UsedRange.Clear 
      wb.Sheets("Data").Range("A1").Value = 0 
      Workbooks("DFFPHI_w_QAQC.xlsm").Sheets("Data").Range("B1:BO2400").Copy Destination:=wb.Sheets("Data").Range("B1") 
      End If 

     Workbooks("DFFPHI_w_QAQC.xlsm").Activate 

     If Sheets("Master - DO NOT MOVE").Range("B6") = True Then 
     wb.Activate 
     wb.Sheets("Template").UsedRange.Clear 
     Workbooks("DFFPHI_w_QAQC.xlsm").Sheets("Template").Range("A1:G524").Copy Destination:=wb.Sheets("Template").Range("A1") 
      If Left(wb.Sheets(1).Range("I7"), 3) = "PO " Or Left(wb.Sheets(1).Range("I7"), 3) = "PO#" Then 
      wb.Sheets(1).Range("I7").Copy Destination:=wb.Sheets("Template").Range("F3") 
      End If 
     End If 
    End If 

    wb.Activate 
    Call update_dropdowns 
    Call update_ga_formula(wb.Name) 

    wb.Sheets(Array("Template", "Data")).Select 
    ActiveWindow.SelectedSheets.Visible = False 
    wb.Activate 
With wb 
    Set xPro = .VBProject 
    Set xCom = xPro.VBComponents("ThisWorkbook") 
    Set xMod = xCom.CodeModule 
    xMod.DeleteLines 1, _ 
    xMod.CountOfLines 
    xMod.AddFromFile strCodePath 
End With 

    wb.Activate 
With wb.Sheets(1) 
.Protect Password:="xxxxxxx", UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True 
.EnableOutlining = True 
End With 

    wb.Save 
    wb.Close <<<<<EXCEL CRASHES HERE>>>>>>> 

End If 

Next 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
End Sub 

Answer 1

刚刚完成：

在我的具体情况中，我将BeforeClose事件添加到目标工作簿ThisWorkbook对象。在正在执行此操作的代码中，在将BeforeClose代码插入到目标工作簿中并且源代码尝试使用wb.Close关闭工作簿后，该代码崩溃。

我改变：

wb.Close 

到

Application.EnableEvents = False 
wb.Close 
Application.EnableEvents = True 

所以，完全绕过了目标工作簿事件和它的固定。

Answer 2

检查在WB关闭代码/保存事件的任何无效操作：

• BeforeClose（）
• BeforeSave（）
• SheetDeactivate（）
• WindowDeactivate（） etc

---

没有关系，但除去.Activate语句，如果需要

例如限定对象：

Workbooks("DFFPHI_w_QAQC.xlsm").Activate 
    If Sheets("Master - DO NOT MOVE").Range("B4") = True Then 

应

If Workbooks("DFFPHI_w_QAQC.xlsm").Sheets("Master - DO NOT MOVE").Range("B4") = True Then 

---

声明.Select和.Activate更换不需要并且性能较差