How to Find a Lost Folder Using VBA

[Eutychus]

After two weeks of searching, I'm resorting to getting help. I want to be able to find a lost folder, whether or not it has any files in it. I want to be able to specify the drive or path in which to search and have the procedure return to me all the (parent) paths in which the particular folder name was found. I'd like to be able to exclude certain folder levels from the search results if possible. And, not as importantly, I'd like to be able to use wildcards in the folder name if possible. The reason for this is because we have thousands of clients, each of whom have the same setup of subfolders. Occasionally, a user will mistakenly drag and drop a client's subfolder who-knows-where. I need to be able to find it. For example:
On Drive H: among other folders we have a folder for each letter of the alphabet. Then under each letter, we have a subfolders for each Client whose name begins with that letter. Then under each client we have subfolders that could be called something like ClientInfo, ClientBusiness, Legal, Notes, etc. A path could look like: H:\Clients\S\Smith\ClientInfo. Sometimes a Client folder with its subfolders is mistakenly dragged and dropped. Sometimes just a subfolder is mistakenly dragged and dropped. It could be dropped anywhere, as you can imagine. Since every client has a folder named Legal, for example, I don't need to see the thousands of Clients with a folder named Legal. I only need to see the paths at some other level than the Client folder level or on some other drive. That's why the Vista search facility is not what I need. I'd like to be able to specify, Give me all the folders named Legal that are not immediately under a Client folder. It might be under another Client's Legal Folder or ClientInfo folder. It might be under a letter folder. It might be on another drive, say, G:.
I have included below code that does something similar to this for finding lost files, but I cannot find a comparable property or method to the Application.FileSearch property. I've tried using the Dir function, but this requires me to be too specific regarding the path to search and seems to require searching for a file rather than a folder.
We have Vista Business on our machines with MS Office 2003 Pro. I want to build this search into our Access 2003 application for the users.
I'm hoping someone has a solution.
Thank you!

Code:
sSearchName = Trim(Forms!frmFindFile![SearchName])
sSearchPath = Forms!frmFindFile![SearchPath]
Set fs = Application.FileSearch

Set fs2 = CreateObject("Scripting.FileSystemObject")

fs.LookIn = sSearchPath
fs.SearchSubFolders = True
fs.FileName = sSearchName

If fs.Execute() > 0 Then
MsgBox "There were " & fs.FoundFiles.Count & " file(s) found."

For i = 1 To fs.FoundFiles.Count
Filespec = fs.FoundFiles(i)
Set f = fs2.GetFile(Filespec)
s = f.Name & " in " & f.ParentFolder & vbCrLf
' s = s & "Created: " & f.DateCreated & vbCrLf
' s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
' s = s & "Last Modified: " & f.DateLastModified
sFile = f.Name
spath = f.ParentFolder
sSearchStr = spath
' ----- Add to my table -------------------------
MySet.AddNew
MySet!MyFileName = sFile
MySet!MyPath = spath
MySet.Update
Next i
Else
MsgBox "There were no files found."
End If

 

[jrbarnett]

Can I suggest the following:

1. A table with a foldername field containing one of the top level folder necessary under each of the client folders (so in your example you would have ClientInfo, ClientBusiness, Legal, Notes as separate rows)

2. To evaluate only top level folders without trawling through its sub folders you can use similar to the following. Its adapted from the Access XP VBA help topic "Dir Function Example"

[/code]
Sub test1()

Dim strTopFolder As String
Dim strTemp As String

strTopFolder = "c:\"

strTemp = Dir(strTopFolder, vbDirectory)
Do While strTemp <> ""
If (GetAttr(strTopFolder & strTemp) And vbDirectory) = vbDirectory Then
Debug.Print strTemp
End If
strTemp = Dir
Loop

End Sub
[/code]

What you need to do is where the debug.print statement is, check for the existence of a subfolder (under strTopFolder and strTemp) for each of those in your table from step 1, and if not, add it to your results list MySet for review later.
It would be a bit more work for a folder to pick up anything else that wasn't in that list, but could be done.

John

 

[TheAceMan1]

How are ya Eutychus . . .

The post by [blue]jrbarnett[/blue] is a good one. Might I suggest you [blue]search for a file[/blue] that should exist in the Dir ([blue]narrowing the search big time![/blue] ).

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[formerTexan]

Hi Eulychus,

Once you have set up a mechanism to loop through the desired directory structure, you can incorporate string comparison functions to run against each directory path.

Either save all the directory paths into a table and then run the comparisons or do it on the fly as you are looping through the directories.

You can test if "Client/" preceeds "Legal" or you can feed the full directory path into the Split(strPath, "/") function and validate all the directories in the path. Lots of other possibilities if you want to get more sophisticated.

Of course any system that allows users to shuffle files and folders willy-nilly is sort of asking for misery.

Cheers, Bill

 

[Eutychus]

Thanks everyone for the replies. I think I should have specified that the procedure needs to search subfolders as well. I think it was implied by my saying I don't know where the folder is dropped, but I should have stated it explicitly. My fault. Unless I'm missing something, the Dir function does not return subfolders. The Application.FileSearch has a SearchSubFolders property (see code above), so I can do the search the way I want when looking for files, but when searching for folders, I can't get multiple levels of subfolders with Dir Function. If I search under folder "Clients" or under folder "S," I want to search all folders and their subfolders and so on that fall under whatever topmost level folder or drive I specify. It would be like the DOS command "Dir [drive:][path][filename] /s" with the /s subfolders switch. Of course, I only want to search for folders, not files. I had seen the Dir Function example in VBA Help, but could not find a way to include subfolders.
Any suggestions? Am I missing something?
Thanks an advance for any help here.

 

[formerTexan]

Hi Eutychus,

The Dir function will only return the immediate tier of subdirectories, so it is going to require some additional work if you want to drill down through the entire sudirectory structure.

The following code uses the more elementary API calls to accomplish what you are attempting. Dir is basically just a wrapper for some of the API functions anyway. A caveat: although I strongly suspect Vista still honors the API functions, you will need to test and verify. Of course you will need to do this with any solution to your problem.

Note: at some point I ran a speed test of API functions vs Dir function and the API functions were a bit faster. The difference is somewhat less than trivial with large directories.

Private Const MAXPATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Declare Function apiFindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
  (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function apiFindNextFile Lib "kernel32" Alias "FindNextFileA" _
  (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function apiGetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
    (ByVal lpFileName As String) As Long
    
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private UTCType As FILETIME

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAXPATH
    cAlternate As String * 14
End Type


' ===========
' Purpose: to find all directories and subdirectories of designated drive/directory.
' Parameters: sPath - full path of drive/directory to search
'             iDirCount - pass in a zero(0)
' Returns: --
'          loads string array with paths and directory names
'          does NOT return files
' Notes:
    'ADAPTED FROM: KPD-Team 1999
    'URL: [URL unfurl="true"]http://www.allapi.net/[/URL]
    'modified 05/2003: file and directory searches are seperated
    'modified 07/2003: to only return directories
' ===========
Public Function fGetDir(sPath As String, iDirCount As Integer) As Variant
Dim strDirName As String       ' SubDirectory Name
Dim astrDir() As String        ' holds paths of directories found
Dim astrDirName() As String    ' Buffer for directory name entries
Dim nDir As Integer            ' Number of directories in this path
Dim i As Integer               ' loop counter
Dim iCt As Integer             ' array counter
Dim hSearch As Long            ' Search Handle
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer            ' exit test

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim astrDirName(nDir)
    Cont = True
    hSearch = apiFindFirstFile(sPath & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        strDirName = fStripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (strDirName <> ".") And (strDirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If apiGetFileAttributes(sPath & strDirName) And FILE_ATTRIBUTE_DIRECTORY Then
                astrDirName(nDir) = strDirName
'Debug.Print path & strDirName
'Debug.Print WFD.cFileName
                iDirCount = iDirCount + 1
                nDir = nDir + 1
                ReDim Preserve astrDirName(nDir)
            End If
        End If
        Cont = apiFindNextFile(hSearch, WFD) 'Get next subdirectory.
        Loop
        Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
        ' Recursively walk into them...
        For i = 0 To nDir - 1
            fGetDir = fGetDir + fGetDir(sPath & astrDirName(i) & "\", iDirCount)
                ' load paths and directory names into array
                ReDim Preserve astrDir(2, iCt)
                astrDir(1, iCt) = sPath & astrDirName(i)
                iCt = iCt + 1
        Next i
    End If
End Function

Private Function fStripNulls(sOriginal As String) As String
    If (InStr(sOriginal, Chr(0)) > 0) Then
        sOriginal = Left$(sOriginal, InStr(sOriginal, Chr(0)) - 1)
    End If
    fStripNulls = sOriginal
End Function

Cheers, Bill