Macro to close every Workbook in all Excel instances.

Hello Everyone,

I wrote the following to close all workbook except the one associated to the running macro

HTML Code: 

It works fine, but I wonder how to close workbooks in other instances.

would you know if this is possible?

thanks for your time.

-Philippe

Hi Philippe,

Excellent question, even though it took 5 months to answer. See the attached sample file (with four 'data only' files) and code that follows that has the following capabilities:
a. Count the number of open Excel Instances.
b. Identify All Open Workbooks in All Open Instances of Excel.
c. Close All Open Workbooks in All Open Instances of Excel except for the Workbook that is running the code. PERSONAL.xls or equivalent is closed in ALL Workbooks.
d. Close PERSONAL.XLS or equivalent in the current instance of Excel without asking and without saving.
e. Access the contents of an Excel File in another instance of Excel.

Lewis

Code follows in an Ordinary Code Module such as Module1:

Option Explicit
'Reference: cytop (Thank you) http://www.ozgrid.com/forum/showthread.php?t=182853
 
'The following declarations are for 32 bit Excel only
Private Declare Function GetDesktopWindow Lib "User32" () As Long

Private Declare Function PostMessage Lib "User32" _
         Alias "PostMessageA" _
         (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         ByVal lParam As Long) As Long
         
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
 
Private Declare Function IIDFromString Lib "ole32" _
(ByVal lpsz As Long, ByRef lpiid As GUID) As Long
 
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
Private Const RETURN_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub ClearA21ToA9999()
  Sheets("Main").Range("A21:A9999").ClearContents
End Sub

Sub CountExcelInstances()
  MsgBox "The number of open Excel Instances is " & GetExcelInstanceCount() & "."
End Sub


Function GetExcelInstanceCount() As Long
  'This counts Excel Instances including the current one
  'Reference: Allen Wyatt (Thank you) http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html
    
  Dim hWndDesk As Long
  Dim hWndXL As Long

  'Get a handle to the desktop
  hWndDesk = GetDesktopWindow

  Do
    'Get the next Excel window
    hWndXL = FindWindowEx(GetDesktopWindow, hWndXL, "XLMAIN", vbNullString)

    'If we got one, increment the count
    If hWndXL > 0 Then
      GetExcelInstanceCount = GetExcelInstanceCount + 1
    End If

  'Loop until we've found them all
  Loop Until hWndXL = 0
  
End Function


Sub DisplayDataForAllOpenExcelInstances()
  'This displays information about all open instances of Excel
  
  Dim xlApp As Object
  Dim wb As Object
  Dim ws As Object
  
  Dim iCountInstances As Long
  Dim iCountWorkbooks As Long
  Dim iRow As Long
  Dim hWndXL As Long
  
  'Clear the output area
  Call ClearA21ToA9999
  
  'Set the row number to the row before the first output row
  iRow = 20
  
  'Output a Start message
  iRow = iRow + 1
  Sheets("Main").Cells(iRow, 1) = "DisplayDataForAllOpenExcelInstances() started on " & Now() & "."
       
 'Find the first Excel Window
  hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
     
  'Loop until there are no more Open Instances of Excel
  While hWndXL > 0
         
    'Increment counter
    iCountInstances = iCountInstances + 1
         
    'Print Instance & Handle to Debug window
    iRow = iRow + 1
    iRow = iRow + 1
    iRow = iRow + 1
    Sheets("Main").Cells(iRow, 1) = "Instance #" & iCountInstances & ":  Handle: " & hWndXL
         
    'Get a reference to it
    If GetReferenceToXLApp(hWndXL, xlApp) Then
    
      'Clear the Workbook count
      iCountWorkbooks = 0
             
      'Iterate through the workbook
      For Each wb In xlApp.Workbooks
      
        'Increment the count of Workbooks in this instance
        iCountWorkbooks = iCountWorkbooks + 1
         
        'Output Workbook name
        iRow = iRow + 1
        iRow = iRow + 1
        Sheets("Main").Cells(iRow, 1) = "Workbook " & iCountWorkbooks & ": " & wb.Name
                 
        'List worksheets in the Workbook
        For Each ws In wb.Worksheets
           iRow = iRow + 1
           Sheets("Main").Cells(iRow, 1) = "Workbook " & iCountWorkbooks & ": " & wb.Name & _
                                           "     Sheet: " & ws.Name
        Next ws
              
      Next wb
    End If
         
    'Find the next Excel Window
    hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
         
  Wend
     
End Sub
 
Sub CloseAllOtherWorkBooksInAnyInstanceOfExcelWithoutSavingOrAsking()
  'This closes all Workbooks in any Instance of Excel without saving or asking
  'except for the workbook running the code
  
  Const WM_CLOSE = &H10
  Const WM_QUIT = &H12
  
  Dim xlApp As Object
  Dim wb As Object
  
  Dim hWndXL As Long
  
  Dim bWorkbookIsRunningTheCode As Boolean
  
 'Find the first Excel Window
  hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
     
  'Loop until there are no more Open Instances of Excel
  While hWndXL > 0
         
    'Get a reference to it
    If GetReferenceToXLApp(hWndXL, xlApp) = True Then
    
      'Clear the 'ThisWorkbook' flag
      bWorkbookIsRunningTheCode = False
      
      'Iterate through the workbook
      'Close all Workbooks except 'ThisWorkbook'
      For Each wb In xlApp.Workbooks
        If wb.Name = ThisWorkbook.Name Then
          bWorkbookIsRunningTheCode = True
          'Debug.Print wb.Name & "    (ThisWorkbook)"
        Else
          'Debug.Print wb.Name
          wb.Saved = True
          wb.Close
        End If
      Next wb
      
      'Close all instances of Excel except the instance that contains 'ThisWorkbook'
      'This will NOT close an instance of Excel that had no Workbooks because 'GetReferenceToXLApp()' returns FALSE
      If bWorkbookIsRunningTheCode = False Then
        Call PostMessage(hWndXL, WM_QUIT, 0&, 0&)
      End If
      
    Else
      'There are no open Workbooks in this Instance of Excel
      'Use another means to close the instance since there is no 'xlApp' object
      Call PostMessage(hWndXL, WM_QUIT, 0&, 0&)

    End If
         
    'Find the next Excel Window
    hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
         
  Wend
     
End Sub

Sub ClosePersonalDotXlsOrEquivalentInTheActiveWorbook()
  'This closes 'PERSONAL.XLS' or equivalent in the Active Workbook without asking and without saving
  '
  'There is probably an easier way to get the handle for the current instance of Excel
  'than to loop through all instances
  
  Dim xlApp As Object
  Dim wb As Object
  
  Dim hWndXL As Long
  
  Dim bPersonalDotXlsRemoved As Boolean
  
  Dim sName As String
  
  'Get the Windows Handle for the current instance of Excel
  hWndXL = Application.hwnd
  
  
  'Loop until there are no more Open Instances of Excel
  If hWndXL > 0 Then
         
    'Get a reference to it
    If GetReferenceToXLApp(hWndXL, xlApp) Then
    
      'Iterate through the workbook
      For Each wb In xlApp.Workbooks
      
        'Close 'PERSONAL.XLS' or equivalent from the Instance of Excel
        If wb.Name Like "PERSONAL.XLS*" Then
          sName = wb.Name
          wb.Saved = True
          wb.Close
          bPersonalDotXlsRemoved = True
        End If
        
      Next wb
    End If
         
  End If
     
  'Output a completion message
  If bPersonalDotXlsRemoved = True Then
    MsgBox sName & " closed in the current Instance of Excel."
  Else
    MsgBox "'PERSONAL.XLS' or equivalent NOT closed in the current Instance of Excel because it was NOT THERE."
  End If
End Sub


Function GetReferenceToXLApp(hWndXL As Long, ByRef xlApp As Object) As Boolean
  'This returns a reference to a specific instance of Excel (ByRef xlApp)
  'The Instance is defined by the Handle (hWndXL) passed by the calling procedure
  '
  'True is returned if the reference to a Specific Instance of Excel is found
     
  Dim hWinDesk As Long
  Dim hWin7 As Long
     
  Dim obj As Object
  Dim iID As GUID
     
  'Rather than explaining, go read
  'http://msdn.microsoft.com/en-us/library/windows/desktop/ms687262(v=vs.85).aspx
  Call IIDFromString(StrPtr(IID_IDispatch), iID)
     
  'We have the XL App (Class name XLMAIN)
  'This window has a child called 'XLDESK' (which I presume to mean 'XL desktop')
  'XLDesk is the container for all XL child windows....
  hWinDesk = FindWindowEx(hWndXL, 0&, "XLDESK", vbNullString)
     
  'EXCEL7 is the class name for a Workbook window (and probably others, as well)
  'This is used to check there is actually a workbook open in this instance.
  hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
     
  'Deep API... read up on it if interested.
  'http://msdn.microsoft.com/en-us/library/windows/desktop/dd317978(v=vs.85).aspx
  If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iID, obj) = RETURN_OK Then
    Set xlApp = obj.Application
    GetReferenceToXLApp = True
  End If
     
End Function


Sub OpenFileyyyDotXlsInNewInstanceOfExcel()

  Dim sFileName As String
  Dim sPath As String
  Dim sWorkBookFriendName As String
  
  'Folder that contains the Excel file
  sPath = ThisWorkbook.Path & "\"
  
  'File Name to be opened
  sFileName = "yyyy.xls"
  
  'Name of Open Workbook in the Instance of Excel to be accessed
  'No name means open New Instance of Excel
  sWorkBookFriendName = ""

  Call OpenNewWorkbookInSpecificInstanceOfExcel(sWorkBookFriendName, sPath, sFileName)

End Sub

Sub OpenNewWorkbookInSpecificInstanceOfExcel(sWorkBookNameInExcelInstance As String, sPath As String, sFileName As String)
  'This opens an Excel file in the same instance of Excel that contiains the Workbook 'sWorkBookNameInExcelInstance'.
  'If that Workbook does not exist or is BLANK, then the file is opened in a NEW Instance of Excel.
  '
  'Adapted from Andy Pope circa 2003 - Thank you again, Andy.
  'http://www.ozgrid.com/forum/showthread.php?t=16893

  Dim xlApp As Application
  Dim xlBook As Workbook
  Dim wb As Workbook
  
  Dim hWndXL As Long
  
  Dim bFoundMatchingWorkbookName As Boolean
  
  Dim sPathAndFileName As String
    
  'Create the Path and File Name for the Workbook
  sPathAndFileName = sPath & sFileName
  
    
 'Find the first Excel Window
  hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
     
  'Procecess this instance of Excel
  While hWndXL > 0
         
    'Get a reference to it
    If GetReferenceToXLApp(hWndXL, xlApp) = True Then
    
      'Clear the 'ThisWorkbook' flag
      bFoundMatchingWorkbookName = False
      
      'Iterate through the workbook names
      'If a match is found to the input Workbook Name, open the Excel file in that instance of Excel
      For Each wb In xlApp.Workbooks
        If UCase(wb.Name) = UCase(sWorkBookNameInExcelInstance) Then
          bFoundMatchingWorkbookName = True
    
         'Open the File in the new instance of Excel
         Set xlBook = xlApp.Workbooks.Open(sPathAndFileName)
         
          'Debug.Print wb.Name & "    (ThisWorkbook)"
        End If
      Next wb
      
    End If
         
    If bFoundMatchingWorkbookName = False Then
      'Find the next Excel Window
      hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
    Else
      'Set the exit condition
      hWndXL = 0
    End If
         
  Wend

  'If there was no Match for the Input Workbook Name, open the Excel File in a NEW instance of Excel
  If bFoundMatchingWorkbookName = False Then
    'Open a new Instance of Excel and make it visible
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    
    'Open the File in the new instance of Excel
    Set wb = xlApp.Workbooks.Open(sPathAndFileName)
  End If

  'Clear the object pointers
  Set xlApp = Nothing
  Set wb = Nothing
    
End Sub


Sub AccessWorkbookyyyyDotXlsInDifferentInstanceOfExcel()
  'This accesses open file 'yyyy.xls' in a different instance of Excel.
  
  Dim xlApp As Application
  Dim wb As Workbook
  Dim myRange As Range
  Dim r As Range
  
  Dim hWndXL As Long
  Dim iRow As Long
  
  Dim bFoundMatchingWorkbookName As Boolean
  
  Dim sSheetName As String
  Dim sWorkbookName As String
  
  sWorkbookName = "yyyy.xls"
  sSheetName = "Sheet1Y"
 
  
  'Clear the output area
  Call ClearA21ToA9999
  
  'Set the row number to the row before the first output row
  iRow = 20
  
  'Output a Start message
  iRow = iRow + 1
  Sheets("Main").Cells(iRow, 1) = "AccessWorkbookyyyyDotXlsInDifferentInstanceOfExcel() started on " & Now() & "."
  
  iRow = iRow + 1
  Sheets("Main").Cells(iRow, 1) = "Workbook: " & sWorkbookName
  
  iRow = iRow + 1
  Sheets("Main").Cells(iRow, 1) = "Sheet: " & sSheetName
  
  iRow = iRow + 1
 
 'Find the first Excel Window
  hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
     
  'Procecess this instance of Excel
  While hWndXL > 0
         
    'Get a reference to it
    If GetReferenceToXLApp(hWndXL, xlApp) = True Then
    
      'Clear the 'ThisWorkbook' flag
      bFoundMatchingWorkbookName = False
      
      'Iterate through the workbook names
      'If a match is found to the input Workbook Name, open the Excel file in that instance of Excel
      For Each wb In xlApp.Workbooks
        If UCase(wb.Name) = UCase(sWorkbookName) Then
          bFoundMatchingWorkbookName = True
          
          Set myRange = wb.Sheets("Sheet1Y").Range("A11:E20").SpecialCells(xlCellTypeConstants)
    
          For Each r In myRange
            iRow = iRow + 1
            Sheets("Main").Cells(iRow, 1) = r.Address(False, False) & " =  " & r.Value
          Next r
        
        End If
      Next wb
      
    End If
         
    If bFoundMatchingWorkbookName = False Then
      'Find the next Excel Window
      hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
    Else
      'Set the exit condition
      hWndXL = 0
    End If
         
  Wend

  'If there was no Match for the Input Workbook Name, open the Excel File in a NEW instance of Excel
  If bFoundMatchingWorkbookName = False Then
    iRow = iRow + 1
    Sheets("Main").Cells(iRow, 1) = "Nothing Done.  Workbook '" & sWorkbookName & "' is NOT OPEN in any Instance of Excel."
  End If

  'Clear the object pointers
  Set xlApp = Nothing
  Set wb = Nothing
  Set r = Nothing
    
End Sub

Thanks LJMetzger. Now I need to debug through it step by step to understand it.

Hi

I know this thread is old, but I'm hoping someone might be able to help.

I'm getting a compile error, type mismatch at:

Call IIDFromString(StrPtr(IID_IDispatch), iID)

I'm running Office 365 Pro Plus OS 64bit, Excel 64bit. I've adapated the Private Declare statements at the beginning to be compatible with 64bit, ie "Private Declare PtrSafe Function" etc

Any help greatly appreciated.

Cheers

pvr928

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.

----------------------

It is very difficult to debug a problem like yours out of context. If you still need a reply, start a new thread, that contains all the code (including API routine declarations) that will clearly demonstrate your problem.

Lewis