Search for a folder

[Jfp87]

Guys,

I am trying to create a group of procedures that will search for a specific folder and return it to the original location which was selected by the user. I’ve placed a read only text file within the folder at its creation. The procedures use this text file to locate the folder in case the original folder name is changed. I’ve been searching backwards from the original path (i.e., C:\Users\Joe\test1 --> C:\Users\Joe .. etc.). Here is the code I have been messing around with:


Sub FolderLocation()
Dim objFSO As Object
Dim strOriginalFolderLocation As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
strOriginalFolderLocation = GetSetting("WP", "Settings", "WP path")
If Not objFSO.FolderExists(strOriginalFolderLocation & Application.PathSeparator & strFolderName) = True Then
Call NonRecursiveMethod(objFSO, strOriginalFolderLocation)
End If
End Sub


Public Sub NonRecursiveMethod(objFSO As Scripting.FileSystemObject, strPath As String) 'strPath is the original folder location.
Dim oFolder, oSubFolder, oFile, queue As Collection
Dim strOriginalFolderLocation As String
Set queue = New Collection
Do
queue.Add objFSO.GetFolder(strPath)
On Error Resume Next
Application.ScreenUpdating = False
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1 'dequeue
For Each oSubFolder In oFolder.SubFolders
queue.Add oSubFolder 'enqueue
If oSubFolder.Attributes = vbNullString Then GoTo lbl_SkipFolder
Next oSubFolder
For Each oFile In oFolder.Files
If oFile.Name = "ZY_11235" Then 'FILE FOUND
'Debug.Print vbCr & "FILE FOUND:" & " " & oFile.Name & vbCr & _
"LOCATION: " & oFile.Path & vbCr & vbCr
'Debug.Print "Copied from: " & oFolder.Path
'Debug.Print "To: " & modUtilities.fcnGetDesktop
'The following msgbox is displayed if the folder is FOUND.
objFSO.MoveFolder oFolder, GetSetting("WP Setup", "UserSettings", "WP Path") & Application.PathSeparator
MsgBox "IMPORTANT: you should keep the folder in the location chosen during setup " & _
"in order for the application to easily access it. " & _
vbCr & vbCr & "Location chosen during setup: " & strOriginalFolderLocation & _
vbCr & vbCr & "Moving it to another location causes the application to search for the folder " & _
"and return it to the original location.", vbOKOnly + vbExclamation, "Folder returned to original location."
Exit Sub
End If
Debug.Print oFile.Name
lbl_SkipFolder:
Next oFile
Loop
strPath = fcnGetNextPath(strPath)
Loop Until InStr(strPath, Application.PathSeparator) = 0
strOriginalFolderLocation = GetSetting("Workpack", "Settings", "WP path")
'This procedure calls the UFNewFolder UserForm if the folder is NOT FOUND in the C: drive.
Call display_UFNewFolder(strOriginalFolderLocation)
End Sub


Private Function fcnGetNextPath(CurrentPath As String) As String
'This function accepts the current path and strips the final location from the path name including the path separator.
'(i.e., C:\Users\Joe --> C:\Users).
Dim intPoint As Integer
intPoint = InStrRev(CurrentPath, Application.PathSeparator)
fcnGetNextPath = Left(CurrentPath, intPoint - 1)
End Function

My question is; what is the best way to accomplish what I am trying to do? I am guessing that this isn’t the best way. Can I use the built in windows search easily & effectively?

Cheers,
Joe

[SamT]

From the Dir Help File
' Display the names in C:\ that represent directories.
MyPath = "c:\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop

For a Recursive Sub, something like this algorithm
'This is not real code

Dim FoundFile As Sting

Sub Findfile(Path As Sting, Filename As String)
Dim Folders As Variant

FoundFile = Dir(Path & FileName)
Do while FoundFile = ""

Do While Folders(Ubound(folders) <> ""
Redim Preserve(Folders(Ubound(folders) + 1)
Folders(Ubound(folders) = Dir(Path, vbDirectiory
Loop
For i = Lbound(folders) to Ubound(folder)
Findfiles = Dir(Folders(i), & FileName)
If FoundFile <> "" then ExitSub
Next
Loop
End Sub

Sub RunRecursive()
FindFile(Path, FileName)
End Sub