Prevent opening duplicate folder or sub-folder in windows explorer-CodePudding

I am using the below code to open a specific folder.
I need to check before open ,if that folder or sub-folder already opened in windows explorer or not , to prevent duplicate.
Appreciate for any useful comments and answers.

Sub Prevent_opening_duplicate_folder ()
 
    Dim Folder_Path As String
     Folder_Path = "D:\Users\Waleed\Desktop\Test"
     Shell "explorer """ & Folder_Path & ""
     DoEvents
 
End Sub

CodePudding user response：

In order to check if a folder or any of its sub-folders are open, please try the next function:

Function isFoldSubFoldOpen(strFolder As String, Optional boolSubFld As Boolean = False) As Boolean
        Dim oShell As Object, Wnd As Object, sFld As Variant

        Set oShell = CreateObject("Shell.Application")
        If boolSubFld Then
            Dim fso As Object, fold As Object, colSFld As New Collection
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set fold = fso.GetFolder(strFolder)
            AllSubFolders fold, colSFld
        End If
        For Each Wnd In oShell.Windows
            If Wnd.name = "Windows Explorer" Or Wnd.name = "File Explorer" Then
               If Wnd.Document.folder.Self.path = strFolder Then isFoldSubFoldOpen = True: Exit Function
               If boolSubFld Then
                    For Each sFld In colSFld
                         If Wnd.Document.folder.Self.path = sFld Then
                            Debug.Print Wnd.Document.folder.Self.path
                            isFoldSubFoldOpen = True: Exit Function
                        End If
                    Next sFld
              End If
            End If
        Next Wnd
End Function

It also needs a recursive Sub, which places all sub-folders in a collection:

Private Sub AllSubFolders(FSOFolder As Object, colSFld As Collection)
 Dim objSubfold As Object, objFile As Object

 For Each objSubfold In FSOFolder.SubFolders
    colSFld.Add objSubfold                 'place the subfolder in the collection
    AllSubFolders objSubfold, colSFld 'recursively call the sub itself
 Next
End Sub

The above function can be called to only return True if the folder is open (without the second parameter, or with it False) or any of its subfolders:

  Debug.Print isFoldSubFoldOpen(FolderPath)       'check if the folder is open
  Debug.Print isFoldSubFoldOpen(FolderPath, True) 'check if the folder or any of its sub-folders are open

CodePudding user response：

This will do it:

Function isFolderOpen(Path As String) As Boolean
    Dim sh As Object, w As Object, Document
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If w.Name = "Windows Explorer" Or w.Name = "File Explorer" Then
        Debug.Print w.Document.folder.self.Path
            Set Document = w.Document
            If Document.folder.self.Path = Path Then
                isFolderOpen = True
                Exit Function
            End If
        End If
    Next
End Function

Reference: Excel VBA to open only one instance of File Explorer

Addenddum

Function isFolderOpenOrSubFolder(Path As String) As Boolean
    Dim sh As Object, w As Object, Document
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If w.Name = "Windows Explorer" Or w.Name = "File Explorer" Then
            Set Document = w.Document
            If Left(Document.folder.self.Path, Len(Path)) = Path Then
                isFolderOpenOrSubFolder = True
                Exit Function
            End If
        End If
    Next
End Function