search PDF file based on main folder name & subfolder(month) throughout userform

[tubrak]

Hi guys,
I search for code to do somethings:
1- I have userform contains combobox1,combobox2 , listbox1
2- the files are PDF in this directory "C:\Users\RT-TU\Desktop\pdf Folder\"
3- pdf Folder contains many folders and each folder will contains subfolders (January ,February .....)
4- should populate in combobox1 the main folders are existed in pdf Folder and populate in combobox2 subfolders(month) based on main folder is selected from combobox1 and show the files PDF in listbox .
5- if I select just combobox1 then will show the whole files whatever month foe each file .
6- if I select combobox1,2 then will show specific files in specific months for specific folder.
7- should show three columns in listbox 1- file name 2- directory 3- modified date
8- if I press the selected item from listbox then will open file .
thanks

 

[John_w]

Try this code.

UserForm module:

Option Explicit

Dim PDFfolder As String
Dim FSO As Object 'Scripting.FileSystemObject

Private Sub UserForm_Initialize()

    Dim PDFsubfolder As Object, subfolder As Object
   
    PDFfolder = "C:\Users\RT-TU\Desktop\pdf Folder\"
   
    If Right(PDFfolder, 1) <> "\" Then PDFfolder = PDFfolder & "\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject
   
    'Fill combobox1 with subfolders in PDF folder
   
    Set PDFsubfolder = FSO.GetFolder(PDFfolder & Me.ComboBox1.Value)
    For Each subfolder In PDFsubfolder.SubFolders
        Me.ComboBox1.AddItem subfolder.Name
    Next
   
    With Me.ListBox1
        .ColumnCount = 3
        .ColumnWidths = "100;280;50"
    End With
   
End Sub


Private Sub ComboBox1_Change()

    Dim thisFolder As Object, subfolder As Object
       
    'Populate combobox2 with month subfolders for the selected combobox1 subfolder
       
    Me.ComboBox2.Clear
    Set thisFolder = FSO.GetFolder(PDFfolder & Me.ComboBox1.Value)
    For Each subfolder In thisFolder.SubFolders
        Me.ComboBox2.AddItem subfolder.Name
    Next
       
    'List files in all month subfolders for the selected combobox1 subfolder
   
    Populate_ListBox Me.ComboBox1.Value, ""
           
End Sub


Private Sub ComboBox2_Change()

    'List files in the selected combobox2 month subfolder for the selected combobox1 subfolder
   
    Populate_ListBox Me.ComboBox1.Value, Me.ComboBox2.Value
   
End Sub


Private Sub ListBox1_Click()

    'Open the selected PDF

    If ListBox1.ListIndex <> -1 Then
        Open_File ListBox1.List(ListBox1.ListIndex, 1) & "\" & ListBox1.List(ListBox1.ListIndex, 0)
    End If
   
End Sub


Private Sub Populate_ListBox(PDFsubfolder As String, monthSubfolder As String)

    'Call the recursive List_PDFs_In_Folder routine for the specified starting folder
   
    Me.ListBox1.Clear
    If monthSubfolder = "" Then
        List_PDFs_In_Folder PDFfolder & PDFsubfolder
    Else
        List_PDFs_In_Folder PDFfolder & PDFsubfolder & "\" & monthSubfolder
    End If

End Sub


Private Sub List_PDFs_In_Folder(folderPath As String)

    Dim thisFolder As Object, subfolder As Object
    Dim thisFile As Object
   
    Set thisFolder = FSO.GetFolder(folderPath)
       
    For Each thisFile In thisFolder.Files
        If LCase(thisFile.Name) Like "*.pdf" Then
            With Me.ListBox1
                .AddItem thisFile.Name
                .List(.ListCount - 1, 1) = thisFile.ParentFolder
                .List(.ListCount - 1, 2) = thisFile.DateLastModified
            End With
        End If
    Next
   
    'Do subfolders
   
    For Each subfolder In thisFolder.SubFolders
        List_PDFs_In_Folder subfolder.Path
    Next
   
End Sub

Standard module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If


Public Sub Open_File(fullFileName As String)
    ShellExecute Application.hwnd, "Open", fullFileName, 0&, 0&, 1&
End Sub

 

[tubrak]

Hi John,
seem there is syntax error . it shows red color in standard module .

 

[John_w]

The red is normal on 64-bit Office and the code should compile without error.

 

[tubrak]

I made sure what I have 64-bit Office !
it will select FUNCTION word .

 

[tubrak]

sorry John!
first I I don't test it because I see red color I thought couldn't run if I don't fix this problem , but surprisingly your code works perfectly and as what I want .
it works despite of it shows red color for procedure in standard module!
last thing: I note when show details files in list box the columns are stuck each other of them , how can I make equal spaces amongst of them ,please?

 

[John_w]

last thing: I note when show details files in list box the columns are stuck each other of them , how can I make equal spaces amongst of them ,please?

I'm not quite sure what you're asking there, but this line sets the widths of the 3 columns in the listbox:

        .ColumnWidths = "100;280;50"

change the numbers to suit.

 

[tubrak]

I'm not quite sure what you're asking there, but this line sets the widths of the 3 columns in the listbox:
VBA Code:
.ColumnWidths = "100;280;50"
change the numbers to suit.

OMG!
I don't note it , sorry buddy!
thanks very much for this project .