关闭所有的工作簿，但没有断开链接的活动之一？

Question

我想关闭所有的工作簿，但是没有断开链接的活动工作簿。

Sub dateUpdate() 

Dim WB As Workbook 
Dim TestWkbk As Workbook 
Dim obj As Object 
Range("C1").Select 

Application.ScreenUpdating = False 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\receiving.xlsx", ReadOnly:=True 
ActiveWindow.Visible = False 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\packing.xlsx", ReadOnly:=True 
ActiveWindow.Visible = False 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\shipping.xlsx", ReadOnly:=True 
ActiveWindow.Visible = False 
Workbooks.Open Filename:=ActiveWorkbook.Path & "\hoist.xlsx", ReadOnly:=True 
ActiveWindow.Visible = False 
ThisWorkbook.Activate 
'Application.ScreenUpdating = True 



If Val(Application.Version) >= 12 Then 
    Set TestWkbk = Nothing 
    On Error Resume Next 
    Set TestWkbk = Workbooks("WinDatePicker.xlam") 
    On Error GoTo 0 
    If TestWkbk Is Nothing Then 
     MsgBox "Sorry the Date Picker add-in is not open." 
    Else 
     Application.Run "'" & TestWkbk.Name & "'!OpenDatePicker", obj 
    End If 
End If 


For Each WB In Workbooks 
If WB.Name <> ThisWorkbook.Name Then 
    WB.Close savechanges:=False 
End If 
Next WB 


End Sub 

如果我选择一个新的日期，那么因为书已经关闭，我会得到参考错误。任何方式在这个？

Answer 1

下面的代码将关闭所有的工作簿，除了活动一个

Dim wb As Workbook 
For Each wb In Application.Workbooks 
    If Not (wb Is Application.ActiveWorkbook) Then 
     wb.Close 
    End If 
Next 

Answer 2

闭幕式以外的所有活动工作簿

Sub test() 
    Application.DisplayAlerts = False 
    Dim ActiveWB: ActiveWB = ThisWorkbook.Name 

    For Each wb In Application.Workbooks 
     If (wb.Name <> ActiveWB) Then 
      wb.Close 
     End If 
    Next 
End Sub