populating list of PDF files from folders & subfolders within directory in dropdown and open it

Alaa mg

Active Member
Joined
May 29, 2021
Messages
375
Office Version
  1. 2019
Hi
I have PDF files within folders & subfolders in this directory "C:\Users\A-LL\Desktop\RET"
the directory will be PDF files like this
"C:\Users\A-LL\Desktop\RET\A200.PDF"
"C:\Users\A-LL\Desktop\RET\INVNO\INB122.PDF"
"C:\Users\A-LL\Desktop\RET\INVNO\SSS\AW300.PDF"
so I would populate list of PDF files are existed in directory in column B when select B1,B2,B3.... and when select item from dropdown(data validation) then should open the file .

thanks
 
it shows the directory whole in list as in post#2 !

That's what you asked for:
each cell in column B should contain list for all of files

If you only want PDFs then replace Function List_PDF_Files with:
VBA Code:
Private Function List_PDF_Files(folderPath As String, destCell As Range) As Long
    
    Static FSO As FileSystemObject
    Dim FSfolder As Object, FSsubfolder As Object
    Dim FSfile As Object
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'List files in this folder
    List_PDF_Files = 0
    Set FSfolder = FSO.GetFolder(folderPath)
    For Each FSfile In FSfolder.Files
        If LCase(FSfile.Name) Like "*.pdf" Then
            destCell.Offset(List_PDF_Files).Value = FSfile.Name
            List_PDF_Files = List_PDF_Files + 1
        End If
    Next
    
    'List files in subfolders of this folder
    For Each FSsubfolder In FSfolder.SubFolders
        List_PDF_Files = List_PDF_Files + List_PDF_Files(FSsubfolder.Path, destCell.Offset(List_PDF_Files))
    Next
    
End Function

ans when try select item to open will show complie error in this word HasValidation for this line in sheet module

The code for Function HasValidation is in post #4 and goes in the standard module.

If still not working as you wish, please provide screenshots showing exactly what you require.
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
If still not working as you wish, please provide screenshots showing exactly what you require.
this is I got when try to open selected file.
t.JPG
 
Upvote 0
As I said, the code for the HasValidation function is in the first piece of code in post #4:


Copy the HasValidation function exactly as shown in post #4 to the standard module and then the code should compile without error.

By screenshots I mean the contents of column B cells and the data validation dropdowns that you want.
 
Upvote 0
Code in the Sheet module:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim mainFolder As String
    Dim fullFileName As String
     
    mainFolder = "C:\Users\A-LL\Desktop\RET\"
 
    If Target.Column = 2 And Target.Cells.Count = 1 Then
        If HasValidation(Target) Then
            fullFileName = Find_File(mainFolder, Target.Value)
            ThisWorkbook.FollowHyperlink fullFileName
        End If
    End If
 
End Sub
you said in sheet module and this is what I did it !
Copy the HasValidation function exactly as shown in post #4 to the standard module and then the code should compile without error.
are sure from that? !
 
Upvote 0
you said in sheet module and this is what I did it !

No I didn't. In post #4 I said:

Code in a standard module.
and that code includes the HasValidation function code.


are sure from that? !

Yes. HasValidation is defined as a Public Function in the standard module, so it can be seen by code anywhere in the VBA project, including the sheet module.

Here is all the code you should need.

Code in a standard module. Puts the PDF file names in column B on "Sheet1" starting at B2 and creates a data validation dropdown containing every PDF file name in each of those cells.

VBA Code:
Public Sub Data_Validation_PDF_Files2()
       
    Dim mainFolder As String
    Dim destCell As Range
    Dim numRows As Long
       
    mainFolder = "C:\Users\A-LL\Desktop\RET\"
       
    Application.EnableEvents = False
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells.Clear
        Set destCell = .Range("B2")
        numRows = List_PDF_Files(mainFolder, destCell)
        With destCell.Resize(numRows)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & .Address
        End With
    End With
    Application.EnableEvents = True
   
End Sub


Private Function List_PDF_Files(folderPath As String, destCell As Range) As Long
   
    Static FSO As FileSystemObject
    Dim FSfolder As Object, FSsubfolder As Object
    Dim FSfile As Object
   
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    'List files in this folder
    List_PDF_Files = 0
    Set FSfolder = FSO.GetFolder(folderPath)
    For Each FSfile In FSfolder.Files
        If LCase(FSfile.Name) Like "*.pdf" Then
            destCell.Offset(List_PDF_Files).Value = FSfile.Name
            List_PDF_Files = List_PDF_Files + 1
        End If
    Next
   
    'List files in subfolders of this folder
    For Each FSsubfolder In FSfolder.SubFolders
        List_PDF_Files = List_PDF_Files + List_PDF_Files(FSsubfolder.Path, destCell.Offset(List_PDF_Files))
    Next
   
End Function


Public Function Find_File(folderPath As String, findFileName As String) As String
   
    Static FSO As FileSystemObject
    Dim FSfolder As Object, FSsubfolder As Object
    Dim FSfile As Object
   
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    'Find the file in this folder
    Find_File = ""
    Set FSfolder = FSO.GetFolder(folderPath)
    For Each FSfile In FSfolder.Files
        If FSfile.Name = findFileName Then
            Find_File = FSfile.Path
            Exit For
        End If
    Next
   
    If Find_File = "" Then
        'Find file in subfolders of this folder
        For Each FSsubfolder In FSfolder.SubFolders
            Find_File = Find_File(FSsubfolder.Path, findFileName)
            If Find_File <> "" Then
                Exit For
            End If
        Next
    End If
   
End Function


Public Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null

    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0

    HasValidation = Not IsNull(t)
End Function

Code in the sheet module for "Sheet1". When the user selects a data validation item in column B it opens the selected file.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim mainFolder As String
    Dim fullFileName As String
       
    mainFolder = "C:\Users\A-LL\Desktop\RET\"
   
    If Target.Column = 2 And Target.Cells.CountLarge = 1 Then
        If HasValidation(Target) Then
            fullFileName = Find_File(mainFolder, Target.Value)
            Application.DisplayAlerts = False
            On Error Resume Next  'in case user clicks Cancel on the warning message
            ThisWorkbook.FollowHyperlink fullFileName
            On Error GoTo 0
            Application.DisplayAlerts = True
        End If
    End If
   
End Sub
 
Upvote 0
Solution
My apologies John !
I misunderstood about function . I thought is existed when you ask from me some adjusting , but seem missed .
well, it open PDF file directly when use another laptop with version 2010 and open directly without show messages .(y)
anyway thank you so much.:)
 
Upvote 0

Forum statistics

Threads
1,223,929
Messages
6,175,457
Members
452,643
Latest member
gjcase

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top