Close folder opened through Explorer.exe

Question

It's a bit of a silly question, but how do you close a folder through Excel VBA ? Below the code to opening it,

Shell "Explorer.exe \\sharepoint.com@SSL\DavWWWRoot\sites\folder", vbMinimizedFocus

This solution with the process ID unfortunately does not work.

Answer 1

The following code loops through all opened Explorer windows. So you can use that to match against the LocationURL and get the window handle hWnd and use Windows API SendMessage to close the window.

Option Explicit

'for 64-bit Excel use
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
'for 32-bit Excel use
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long


Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Public Sub CloseWindowExample()
    Dim sh As Object
    Set sh = CreateObject("shell.application")

    Dim w As Variant
    For Each w In sh.Windows
        'print all locations in the intermediate window
        Debug.Print w.LocationURL

        ' select correct shell window by LocationURL
        If w.LocationURL = "file://sharepoint.com@SSL/DavWWWRoot/sites/folder" Then
            SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
        End If
    Next w
End Sub

Note that the LocationURL path begins with file:// and that all backslashes \ in the path are converted to slashes / as shown in the example.

To make it compatible with both 64 and 32 bit Excel you can use

#If VBA7 Then
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
#Else
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If

Note that one of these will be marked in red as compile error but the code will still run.