Results 1 to 3 of 3
  1. #1
    3 Star Lounger
    Join Date
    Nov 2001
    Location
    Brisbane, Queensland, Australia
    Posts
    330
    Thanks
    10
    Thanked 0 Times in 0 Posts

    How to filter folders by part name

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

    P:\F\FRED ENG\58412

    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
    "Heading for the deep end"

  2. #2
    Silver Lounger
    Join Date
    Mar 2014
    Location
    Forever West
    Posts
    2,078
    Thanks
    0
    Thanked 259 Times in 248 Posts
    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.

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    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

    wey1.png

    wey2.png

    wey3.png

    wey4.png

    In a form module:
    Code:
    Private Sub CommandButton1_Click()
    'GO BUTTON
    UserForm1.Hide
    FindFolders TextBox1, TextBox2
    End Sub
    
    
    Private Sub CommandButton2_Click()
    'BROWSE BUTTON
    On Error Resume Next
    '----------------------------
    'DECLARE AND SET VARIABLES
    Dim dialog As FileDialog
    Dim foldr As String
    '----------------------------
    'OPEN FOLDER DIALOG BOX
    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
    '----------------------------
    'CLEANUP
    Set dialog = Nothing
    End Sub
    In a standard Module:
    Code:
    Public Sub FindFolders(Path As String, Keyword As String)
    On Error Resume Next
    '---------------------------
    'DECLARE AND SET VARIABLES
        Dim FolderCollection As New Collection
        Dim SubFolderString As Variant
        Dim match(), msg As String
        Index = 1
    '---------------------------
    'COLLECT CHILD DIRECTORIES
        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
    '---------------------------
    'COLLECT RECURSIVE CHILD SUBDIRECTORIES
        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
    '---------------------------
    'DISPLAY RESULTS
        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
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •