VBA中的wb.Close中的Excel崩潰

此代碼中的所有內容均可正常工作，除非在最後關閉工作簿時執行某些操作。我將一些代碼插入到工作簿的ThisWorkbook中，該工作簿將從文本文件中打開，並將主電子表格中的一些選項卡複製到我在此循環中打開的每個工作簿中。在循環結束時，當我嘗試關閉並轉向下一個工作簿時，它崩潰。VBA中的wb.Close中的Excel崩潰

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

來源

2017-07-15 Scott

可能重複的[VBA腳本掛在Workbook.Close]（https://stackoverflow.com/questions/13797367/vba-script-hangs-at-workbook-close） –

我試過了。仍然得到相同的問題 – Scott

一些建議：1）嘗試移動wb.Save（wb.Sheets（1）.Protect 2）檢查wb是否受到保護（不僅僅是表單）3）如果有的話，檢查代碼wb關閉/保存事件（BeforeClose，BeforeSave，SheetDeactivate，WindowDeactivate等）用於任何無效操作。不相關，但刪除'.Activate'語句並根據需要限定對象 –

剛剛完成：

在我的具體情況中，我將BeforeClose事件添加到目標工作簿ThisWorkbook對象。在正在執行此操作的代碼中，在將BeforeClose代碼插入到目標工作簿中並且源代碼嘗試使用wb.Close關閉工作簿後，該代碼崩潰。

我改變：

wb.Close

到

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

所以，完全繞過了目標工作簿事件和它的固定。

來源

2017-07-17 14:21:45 Scott

檢查在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更換不需要並且性能較差

來源

2017-07-16 01:15:21

VBA中的wb.Close中的Excel崩潰

回答

相關問題