Excel VBA - Closing a specific File Explorer window out of multiple open File Explorer windows

[CoolAuto]

Cell A3 contains folder path. Cells below contain file names with extensions. Upon selecting a cell below, my Excel macro opens that file's location in File Explorer and out of multiple files in that folder selects this particular one, which can be seen in Preview. When next cell containing another file name is selected on the spreadsheet, another File Explorer window opens, even though it's the same path from A3. Looking for a line of code to add which will first close the first File Explorer window, before opening a new one. The code needs to be closing that specific File Explorer window from cell A3, out of multiple open File Explorer windows. Code I have so far
UPDATE: Running below codes, but it does not close the existing opened folder, just opens yet another:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">If Target.Column = 1 And Target.Row > 5 Then

Call CloseWindow

Shell "C:\Windows\explorer.exe /select," & Range("A3") & ActiveCell(1, 1).Value, vbNormalFocus 'this works, but opens NEW folder every time</code>and in separate Module:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">'BELOW GOES WITH Public Sub CloseWindow() FROM: https://stackoverflow.com/questions/49649663/close-folder-opened-through-explorer-exe
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

'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.


Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Public Sub CloseWindow()
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
'If w.LocationURL = "Range("M1").value" Then
If w.LocationURL = "file://K:/ppp/xx/yy/1 - zzz" Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End If
Next w
End Sub</code>

 

[Jaafar Tribak]

Same error on line on same line: If w.document.focuseditem.Path = FullPathName Then

Do you get that error for all cells with file names that you select ?

 

[Jaafar Tribak]

Try this variation of the CloseWindow routine :

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Object

    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If Not w.Document Is Nothing Then
            If Not w.Document.FocusedItem Is Nothing Then
                If w.Document.FocusedItem.Path = FullPathName Then
                    w.Quit
                    Exit For
                End If
            End If
        End If
    Next w
End Sub

If you still get the error, try adding On Error Resume Next at the start of the routine and see if it works

 

[CoolAuto]

Fair to say yes, tried 12 OF 52, each got that error

 

[CoolAuto]

Try this variation of the CloseWindow routine :

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Object

    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If Not w.Document Is Nothing Then
            If Not w.Document.FocusedItem Is Nothing Then
                If w.Document.FocusedItem.Path = FullPathName Then
                    w.Quit
                    Exit For
                End If
            End If
        End If
    Next w
End Sub

If you still get the error, try adding On Error Resume Next at the start of the routine and see if it works

Same error on line: If Not w.Document.FocusedItem Is Nothing Then

But we do have a winner with On Error Resume Next variation. May you see many many Sexy BellyDancers!!!..

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Object
[B]On Error Resume Next[/B]
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If Not w.Document Is Nothing Then
            If Not w.Document.FocusedItem Is Nothing Then
                If w.Document.FocusedItem.Path = FullPathName Then
                    w.Quit
                    Exit For
                End If
            End If
        End If
    Next w
End Sub

 

[Jaafar Tribak]

Same error on line: If Not w.Document.FocusedItem Is Nothing Then

But we do have a winner with On Error Resume Next variation. May you see many many Sexy BellyDancers!!!..

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Object
[B]On Error Resume Next[/B]
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If Not w.Document Is Nothing Then
            If Not w.Document.FocusedItem Is Nothing Then
                If w.Document.FocusedItem.Path = FullPathName Then
                    w.Quit
                    Exit For
                End If
            End If
        End If
    Next w
End Sub

I think the error occurs because not all Explorer Windows have a focused item so I think ignoring the error should be safe in this scenario .. Anyways, I am glad you finally got the code working and I also hope the moderators don't get too annoyed but, I do have a weak spot for curvy bellydancers

 

[CoolAuto]

Jaafar, Can you take a look at this post at link below - it stems from the code from this thread you helped me with earlier

https://www.mrexcel.com/forum/excel...t-files-excel-same-fe-window.html#post5212313