Option Explicit

'//////////////////////////////////////////////////////

'//                                                  //

'// Search for ALL instances of a Directory within   //

'// your computer for a Directory name you specify   //

'// using WMI - NB: Searches Drives as well          //

'//                                                  //

'// Ivan F Moala                                     //

'// 1st Oct 2003                                     //

'// http://www.XcelFiles.com                         //

'//                                                  //

'//////////////////////////////////////////////////////





Sub FindFolder(blnFindAllMatches As Boolean, strFolderToFind As String)

'//

'// This routine may take a while as it Enumerates through ALL avail

'// Folders AND Drives set up on YOUR computer!!

'//

Dim strComputer As String

Dim objWMIService As Object

Dim colFolders As Object

Dim objFolder As Object

Dim blnFound As Boolean

Dim oldStatusBar As Boolean

Dim iFolderCount As Integer

Dim strTmp As String



Const msgTitle = "Find Directory"



'// Initialise

blnFound = False

strComputer = "."

iFolderCount = 0

oldStatusBar = Application.DisplayStatusBar

Application.DisplayStatusBar = True



Set objWMIService = GetObject("winmgmts:" _

    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory")



'// Ok lets do the job

For Each objFolder In colFolders

    '// change case sensitivity here!

    Application.StatusBar = "Please be patient..." & objFolder.Name

    If UCase(FolderNameOnly(objFolder.Name)) = UCase(strFolderToFind) Then

        blnFound = True

        iFolderCount = iFolderCount + 1

        If Not blnFindAllMatches Then

            Exit For

        Else

            strTmp = strTmp & objFolder.Name & vbCrLf

        End If

    End If

Next



If blnFound And Not blnFindAllMatches Then

    MsgBox "Directory named: " & strFolderToFind & _

        " was found here:=" & objFolder.Name, _

        vbInformation, msgTitle

Else

    If blnFound And blnFindAllMatches Then

        MsgBox iFolderCount & " Directory(s) named: " & strFolderToFind & _

            vbCrLf & "were found here." & vbCrLf & vbCrLf & strTmp, _

            vbInformation, msgTitle

    Else

        MsgBox "Folder named [" & strFolderToFind & "] WAS NOT FOUND!", _

            vbExclamation, msgTitle

    End If

End If



'// clean-up

Application.StatusBar = False

Application.DisplayStatusBar = oldStatusBar

Set objWMIService = Nothing

Set colFolders = Nothing



End Sub



Function FolderNameOnly(strMyFolder As String) As String

'// Gets Folder Name ONLY by Reversing the string

strMyFolder = StrReverse(strMyFolder)

'// Get the string to the left of the first \ and reverse it

strMyFolder = StrReverse(Left(strMyFolder, InStr(strMyFolder, "\") - 1))



FolderNameOnly = strMyFolder



End Function



Sub TesterI()

Dim mstrFolderName As String

Dim mblnAllInstances As Boolean



'// Default is True

mblnAllInstances = True



mstrFolderName = InputBox("Enter Folder name to search for", "Search for Folder")

If Len(mstrFolderName) = 0 Then Exit Sub



MsgBox "Search for" & vbCr & "ALL instances (Yes)" & vbCr & "OR 1st Instance (No)", vbYesNo

If vbNo Then mblnAllInstances = False



FindFolder mblnAllInstances, mstrFolderName



End Sub



Sub TesterII()

'// just substitute your Folder names here;



'   Check IF Folder named A exists in your sys exit on 1st instance

    FindFolder False, "A"         '// This one Exists on my sys



'   Check IF Folder named A exists in your sys get ALL instances

    FindFolder True, "A"          '// This one Exists on my sys



'   Check IF Folder named A exists in your sys exit on 1st instance

    FindFolder False, "NOSUCHDIR" '// This doesn't Exist on my sys



'   Check IF Folder named A exists in your sys get ALL instances

    FindFolder False, "NOSUCHDIR" '// This doesn't Exist on my sys

    

End Sub



Sub XcelFiles_Click()

    Application.VBE.MainWindow.Visible = True

End Sub