How to filter folders by part name

Topic

New Reply

We have an existing folder structure as follows for documents and pictures related to a job.

P:FFRED ENG58412

I am attempting to write code to find a folder based on its name.

eg

Folder name I am looking for: FRED ENGINEERING

folder does not exist but FRED ENG does.

how would I write the filter command below to show all folders that begin with FRE

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = inpath
.Filter = “Folders”
.Show
[FolderPath] = .SelectedItems(1)
End With

Reply | Quote

Replies

Not a solution but maybe an idea? Since back in the days of DOS any Search-type function has needed the use of ‘wild cards’ such as the asterisk * and the question mark ? to replace unknown/missing characters in file and Folder names. Win7’s Windows Explorer and Win8/8.1/10TP’s File Explorer can search on partial names and list potential results but I can’t relate as to how wild cards could be used in your script to do the same. Without the ability to use wild cards does require more complete/precise data to work with.

Before you wonder "Am I doing things right," ask "Am I doing the right things?"

Reply | Quote

Weyrman,

This workbook has a “Search Folder” button that will launch a folder dialog box. The user navigates to the parent folder where the search will begin and enters the search criteria string. Clicking “Go”, the code will recursively search child directories and subdirectories for the keyword then display the full paths of the results in a message box. I have tested it with partial words, upper and lower case, and a hierarchy of 4 directories deep.

HTH,
Maud

41095-wey1

41096-wey2

41097-wey3

41098-wey4

In a form module:

Code:

Private Sub CommandButton1_Click()
[COLOR=”#008000″]’GO BUTTON[/COLOR]
UserForm1.Hide
FindFolders TextBox1, TextBox2
End Sub


Private Sub CommandButton2_Click()
‘BROWSE BUTTON
On Error Resume Next
[COLOR=”#008000″]’—————————-
‘DECLARE AND SET VARIABLES[/COLOR]
Dim dialog As FileDialog
Dim foldr As String
[COLOR=”#008000″]’—————————-
‘OPEN FOLDER DIALOG BOX[/COLOR]
Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
With dialog
    .Title = “Select a Folder”
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show  -1 Then GoTo skip
    foldr = .SelectedItems(1)
End With
skip:
TextBox1 = foldr & “”
TextBox2.SetFocus
[COLOR=”#008000″]’—————————-
‘CLEANUP[/COLOR]
Set dialog = Nothing
End Sub

In a standard Module:

Code:

Public Sub FindFolders(Path As String, Keyword As String)
On Error Resume Next
[COLOR=”#008000″]’—————————
‘DECLARE AND SET VARIABLES[/COLOR]
    Dim FolderCollection As New Collection
    Dim SubFolderString As Variant
    Dim match(), msg As String
    Index = 1
[COLOR=”#008000″]’—————————
‘COLLECT CHILD DIRECTORIES[/COLOR]
    FolderString = Dir(Path, vbDirectory)
    Do While FolderString  vbNullString
        If (FolderString  “.”) And (FolderString  “..”) Then
            If (GetAttr(Path & FolderString) And vbDirectory)  0 Then
                FolderCollection.Add Path & FolderString & “”
                If InStr(1, FolderString, Keyword, vbTextCompare) > 0 Then
                   ReDim Preserve match(Index)
                   match(Index) = Path & FolderString
                   Index = Index + 1
               End If
            End If
        End If
        FolderString = Dir
    Loop
[COLOR=”#008000″]’—————————
‘COLLECT RECURSIVE CHILD SUBDIRECTORIES[/COLOR]
    For Each SubFolderString In FolderCollection
        FolderString = Dir(SubFolderString, vbDirectory)
        Do While FolderString  vbNullString
            If (FolderString  “.”) And (FolderString  “..”) Then
                If (GetAttr(SubFolderString & FolderString) And vbDirectory)  0 Then
                    FolderCollection.Add FolderString & “”
                    If InStr(1, FolderString, Keyword, vbTextCompare) > 0 Then
                       ReDim Preserve match(Index)
                       match(Index) = SubFolderString & FolderString
                       Index = Index + 1
                    End If
                End If
            End If
            FolderString = Dir
        Loop
    Next SubFolderString
[COLOR=”#008000″]’—————————
‘DISPLAY RESULTS[/COLOR]
    For I = 1 To UBound(match)
        If msg = “” Then
            msg = match(I) & Chr(13)
        Else:
            msg = msg & match(I) & Chr(13)
        End If
    Next I
    MsgBox msg
End Sub

Reply | Quote