Close Specific Workbooks Without Saving

[HTSCF Fareha]

I was wondering if somebody could please help me?

Here is the code I currently have linked to a command button which closes all open Workbooks without saving.


Private Sub cmdExit_Click()

Call CloseAllWorkbooksWithoutSaving

End Sub

Quite dramatic I know!

What I would like to achieve is to modify the command button to only close Workbooks that are open that currently have no actual filename, just their original Book1, Book2, Book3 etc leaving anything with a filename open. I've tried searching to find an answer but the best I could come up with was actually naming a specific file to close. The problem is that there could be any number of Workbooks open.

Hoping this is possible?

Thanks!

[p45cal]

Sub blah()
For Each wb In Workbooks
If wb.Path = "" Then wb.Close False
Next wb
End Sub

[Aussiebear]

Shouldn't that be True rather than False?

[georgiboy]

Shouldn't that be True rather than False?

Nope, True = save changes, False = don't save changes

[p45cal]

Shouldn't that be True rather than False?
Well, I took a guess from the WithoutSaving bit!:



Call CloseAllWorkbooksWithoutSaving

[HTSCF Fareha]

Many thanks p45cal, this works exactly as required!

[Aussiebear]

I'm old and at time easily confused... and I often wonder if I'll ever understand vba. Take for example


If wb.Path = " " then wb.Close False


If wb.Path = " " means you have an open instance of a workbook but its not yet saved as there is no recognised path


then wb.Close False in every day English should have meant do not close, hence I would have thought.... it might have been better written as


then wb.Close, False but Microsoft has taken a bat to better English yet again.

[Aflatoon]

Not really - they did name the arguments so that you can write clearly if you choose to do so ;)


If wb.Path = "" then wb.Close savechanges:=false

[Aussiebear]

Gotcha.....:hi:

[HTSCF Fareha]

Had to wait for my document to have a digital signature to be applied for use in the workplace before utilising. The most bizarre thing is that although this worked perfectly in the home environment, it doesn't at work, leaving the Book1, Book2, Book3 etc unsaved files completely untouched! :banghead:

Tried to see if there was anything that could be obviously different but am really struggling other than all our documents are held in OneDrive. But could this affect things even if the files hadn't been saved?

Any ideas anyone please?

[HTSCF Fareha]

Would it make any difference if the Book1, Book2, Book3 etc were produced from new instances of Excel rather than from the macro enabled template where the sub lies?

[Aflatoon]

Yes - if they are in separate instances of Excel, then this code will not recognise them.

[HTSCF Fareha]

Yes - if they are in separate instances of Excel, then this code will not recognise them.

Just checked and you are spot on. If I create new workbooks from the macro enabled template, it will close those instances without issue (work version is 2016). Any further instances of Excel started away from the template it completely ignores.

A previous thread of mine was to close absolutely everything without saving (as mentioned in #1 on this thread). The link for that is here:-
http://www.vbaexpress.com/forum/showthread.php?68893-Close-All-Instances-Of-Excel-Without-Saving-Any-Changes/page2

Is there a way to perhaps modify that so that it will just leave the actual named macro enabled template open? Or is there another way?

[Aussiebear]

Is there a way to perhaps modify that so that it will just leave the actual named macro enabled template open? Or is there another way?

Since the template is already saved it will have a path. The code as kindly supplied by P45cal, only works on workbooks that have not already been saved (that is their path = "" hence the line


if wb.Path = "" then wb.close false

[HTSCF Fareha]

Since the template is already saved it will have a path. The code as kindly supplied by P45cal, only works on workbooks that have not already been saved (that is their path = "" hence the line


if wb.Path = "" then wb.close false

p45cal's suggestion did indeed work but alas only with any unsaved workbooks created from the macro template.

As per Aflatoon's observation and my reply to that, these are the workbooks that get completely ignored.

[georgiboy]

How about looking at the files by window name, you could attach to each excel file by finding excels window names, once attached you can ask for the path and see if it is vbnullstring, if it is then close without saving changes. Try running the sub 'CloseUnsavedInstances' from the below:


Option Explicit

Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpWindowText As String, ByVal nMaxCount As Long) As Long
Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Boolean


Private Function EnumWindowsProc(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As Boolean
Dim buffer As String * 255
Dim title As String
Dim wb As Workbook


GetWindowText hwnd, buffer, 255
title = Left(buffer, InStr(buffer, vbNullChar) - 1)
If InStr(title, " - Excel") > 0 Then
On Error Resume Next
Set wb = Workbooks(Split(title, " - Excel")(0))
On Error GoTo 0
If Trim(wb.Path) = vbNullString Then
wb.Close False
End If
End If
EnumWindowsProc = True
End Function


Sub CloseUnsavedInstances()
EnumWindows AddressOf EnumWindowsProc, 0
End Sub

[Aflatoon]

That won't work with workbooks that are in different Excel instances since they are not part of the Workbooks collection of the primary instance.

@HTSCF Fareha,

What should be done if there are workbooks in any of the other instances of excel that do have paths (i.e. have been saved previously)?

Essentially, you can amend the code you had from your other thread so that you loop through each workbook in each instance:


For i = LBound(xlApps) To UBound(xlApps) With xlApps(i)
for each wb in .Workbooks
if len(wb.path) = 0 then
wb.close savechanges:=false
else
' what happens here?
end if
' may or may not want to quit here?
' If .Hwnd <> Application.Hwnd Then
' .DisplayAlerts = False
' .Quit
' End If
End With
Next i

[georgiboy]

That won't work with workbooks that are in different Excel instances since they are not part of the Workbooks collection of the primary instance.

You are correct, when i was testing, i was testing in Excel 365 and for some reason what i had thought were new instances of Excel were not. When i tested in Excel 2016 it became clear.

[HTSCF Fareha]

My thanks to @georgiboy and @Aflatoon for looking at this.

I've modified my code as:-

' Run as entry point of example
Sub CloseUnsavedInstances()
Dim i As Long
Dim wb
Dim xlApps() As Application
Dim hRunningApp As LongPtr '<--to remove

hRunningApp = Application.HinstancePtr '<--to remove

If GetAllExcelInstances(xlApps) Then
Debug.Print String(30, "-")

For i = LBound(xlApps) To UBound(xlApps)
With xlApps(i)
For Each wb In .Workbooks
If Len(wb.Path) = 0 Then
wb.Close savechanges:=False
Else
' what happens here?
End If
' may or may not want to quit here?
' If .Hwnd <> Application.Hwnd Then
' .DisplayAlerts = False
' .Quit
' End If
End With
Next i

Debug.Print String(30, "=")
End If

'Application.DisplayAlerts = False
'Application.Quit
End Sub

This is throwing up an End With without With error on compiling.


The idea is that when this has closed all the unrequired instances of unsaved workbooks, it returns to the macro template.

[Aflatoon]

I missed out a Next wb line after the first End If

[HTSCF Fareha]

I missed out a Next wb line after the first End If

My thanks, this sorted things out nicely and it is working exactly as required!


Option Explicit

'https://stackoverflow.com/questions/2971473/can-vba-reach-across-instances-of-excel
'http://www.vbaexpress.com/forum/showthread.php?68893-Close-All-Instances-Of-Excel-Without-Saving-Any-Changes

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" (ByVal lpsz As LongPtr, ByRef lpiid As UUID) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal Hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As UUID, ByRef ppvObject As Object) As LongPtr

Type UUID 'GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As LongPtr = &HFFFFFFF0

' Run as entry point of example
Sub CloseUnsavedInstances()
Dim i As Long
Dim wb
Dim xlApps() As Application
Dim hRunningApp As LongPtr '<--to remove

hRunningApp = Application.HinstancePtr '<--to remove

If GetAllExcelInstances(xlApps) Then
Debug.Print String(30, "-")

For i = LBound(xlApps) To UBound(xlApps)
With xlApps(i)
For Each wb In .Workbooks
If Len(wb.Path) = 0 Then
wb.Close savechanges:=False
Else
' what happens here?
End If
Next wb
' may or may not want to quit here?
' If .Hwnd <> Application.Hwnd Then
' .DisplayAlerts = False
' .Quit
' End If
End With
Next i

Debug.Print String(30, "=")
End If

End Sub

' Actual public facing function to be called in other code
Public Function GetAllExcelInstances(xlApps() As Application) As Long
Dim n As Long
Dim app As Application
Dim hWndMain As LongPtr

On Error GoTo MyErrorHandler

' Cater for 100 potential Excel instances, clearly could be better
ReDim xlApps(1 To 100)

hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)


Do While hWndMain <> 0
Set app = GetExcelObjectFromHwnd(hWndMain)

If Not (app Is Nothing) Then
n = n + 1
Set xlApps(n) = app
End If

hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)

Loop

If n Then
ReDim Preserve xlApps(1 To n)
GetAllExcelInstances = n
Else
Erase xlApps
End If

Exit Function

MyErrorHandler:
MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function

Private Function GetExcelObjectFromHwnd(ByVal hWndMain As LongPtr) As Application
Dim hWndDesk As LongPtr
Dim Hwnd As LongPtr
Dim strText As String
Dim lngRet As Long
Dim iID As UUID
Dim obj As Object

On Error GoTo MyErrorHandler

hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)

If hWndDesk <> 0 Then

Hwnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)

Do While Hwnd <> 0

strText = String$(100, Chr$(0))
lngRet = CLng(GetClassName(Hwnd, strText, 100))

If Left$(strText, lngRet) = "EXCEL7" Then

Call IIDFromString(StrPtr(IID_IDispatch), iID)

If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iID, obj) = 0 Then 'S_OK
Set GetExcelObjectFromHwnd = obj.Application
Exit Function
End If

End If

Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString)
Loop

On Error Resume Next

End If

Exit Function

MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function


Highlighting my complete naivety, would I be correct in saying that I could remove:-


Else
' what happens here?
and

' may or may not want to quit here?
' If .Hwnd <> Application.Hwnd Then
' .DisplayAlerts = False
' .Quit
' End If
to tidy things up?

[Aflatoon]

Yes, as they are all commented out currently so not doing anything.

[HTSCF Fareha]

Many thanks indeed to all who participated and assisted in this thread. Final Module code as below:-


Option Explicit

'https://stackoverflow.com/questions/2971473/can-vba-reach-across-instances-of-excel
'http://www.vbaexpress.com/forum/showthread.php?70964-Close-Specific-Workbooks-Without-Saving

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" (ByVal lpsz As LongPtr, ByRef lpiid As UUID) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal Hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As UUID, ByRef ppvObject As Object) As LongPtr

Type UUID 'GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As LongPtr = &HFFFFFFF0

' Run as entry point of example
Sub CloseUnsavedInstances()
Dim i As Long
Dim wb
Dim xlApps() As Application
Dim hRunningApp As LongPtr '<--to remove

hRunningApp = Application.HinstancePtr '<--to remove

If GetAllExcelInstances(xlApps) Then
Debug.Print String(30, "-")

For i = LBound(xlApps) To UBound(xlApps)
With xlApps(i)
For Each wb In .Workbooks
If Len(wb.Path) = 0 Then
wb.Close savechanges:=False
End If
Next wb
End With
Next i

Debug.Print String(30, "=")
End If

End Sub

' Actual public facing function to be called in other code
Public Function GetAllExcelInstances(xlApps() As Application) As Long
Dim n As Long
Dim app As Application
Dim hWndMain As LongPtr

On Error GoTo MyErrorHandler

' Cater for 100 potential Excel instances, clearly could be better
ReDim xlApps(1 To 100)

hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)

Do While hWndMain <> 0
Set app = GetExcelObjectFromHwnd(hWndMain)

If Not (app Is Nothing) Then
n = n + 1
Set xlApps(n) = app
End If

hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)

Loop

If n Then
ReDim Preserve xlApps(1 To n)
GetAllExcelInstances = n
Else
Erase xlApps
End If

Exit Function

MyErrorHandler:
MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function

Private Function GetExcelObjectFromHwnd(ByVal hWndMain As LongPtr) As Application
Dim hWndDesk As LongPtr
Dim Hwnd As LongPtr
Dim strText As String
Dim lngRet As Long
Dim iID As UUID
Dim obj As Object

On Error GoTo MyErrorHandler

hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)

If hWndDesk <> 0 Then

Hwnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)

Do While Hwnd <> 0

strText = String$(100, Chr$(0))
lngRet = CLng(GetClassName(Hwnd, strText, 100))

If Left$(strText, lngRet) = "EXCEL7" Then

Call IIDFromString(StrPtr(IID_IDispatch), iID)

If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iID, obj) = 0 Then 'S_OK
Set GetExcelObjectFromHwnd = obj.Application
Exit Function
End If

End If

Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString)
Loop

On Error Resume Next

End If

Exit Function

MyErrorHandler:
MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function