Fill the listbox only with file name

G

gstylianou

Registered User.
Local time
Today, 09:26
Joined
Dec 16, 2013
Messages
359
Hi,

I found the following code here in the our forum (special thanks to the writer thedbguy) buti'm trying to modify them in order to fill the Listbox only with file name without the path. Following is the code and i will be glad if someone can explain to me how can i do it.

Public Function ListFilesT(FolderPath As String, Optional FileSearch As String, Optional FileExt As String) As String
'3/25/2018
'thedbguy@gmail.com
'optional valid file extensions should include the dot and be separated by semicolons (e.g. .txt;.docx;.xlsx;.accdb)

On Error GoTo ErrHandler

Dim fso As Object
Dim fsoFolder As Object
Dim fsoFile As Object
Dim arrExtensions() As String
Dim var As Variant
Dim x As Long
Dim strFiles As String

'assign valid file extensions to an array
If Not IsMissing(FileExt) Then
arrExtensions = Split(FileExt, ";")
End If

Set fso = CreateObject("Scripting.FileSystemObject")

'check for a valid path
If fso.folderexists(FolderPath) Then
Set fsoFolder = fso.getfolder(FolderPath)

'process subfolders
If fsoFolder.subfolders.Count > 0 Then
For Each var In fsoFolder.subfolders
'recursion
strFiles = ";" & ListFilesT(var.Path, FileSearch, FileExt) & strFiles
Next var
End If

'list files
If fsoFolder.files.Count > 0 Then
For Each var In fsoFolder.files
If IsMissing(FileExt) Or FileExt = "" Then
'check for search keyword, if supplied
If FileSearch = "" Then
' strFiles = ";" & var.Path & strFiles
strFiles = ";" & fso.GetFileName(var.Path) & strFiles ' i tried with this without result..
ElseIf InStr(var.Name, FileSearch) > 0 Then
' strFiles = ";" & var.Path & strFiles
strFiles = ";" & fso.GetFileName(var.Path) & strFiles
End If

Else
'check for valid file extensions, if supplied
For x = LBound(arrExtensions) To UBound(arrExtensions)
'skip files without file extensions
If InStr(var.Name, ".") > 0 Then
If Mid$(var.Name, InStrRev(var.Name, ".")) = arrExtensions(x) Then
'check for search keyword, if supplied
If FileSearch = "" Then
' strFiles = ";" & var.Path & strFiles
strFiles = ";" & fso.GetFileName(var.Path) & strFiles
ElseIf InStr(var.Name, FileSearch) > 0 Then
' strFiles = ";" & var.Path & strFiles
strFiles = ";" & fso.GetFileName(var.Path) & strFiles
End If
End If
End If
Next x
End If
Next var
End If

Else
'bad folder name
MsgBox "Folder does not exist.", vbInformation, "Invalid"

End If

'cleanup list (try to remove extra semicolons
If Right$(strFiles, 1) = ";" Then strFiles = Left$(strFiles, Len(strFiles) - 1)

'return the result
ListFilesT = CleanList(Mid$(strFiles, 2))

errExit:
Set fsoFolder = Nothing
Set fso = Nothing
Exit Function

ErrHandler:
MsgBox Err.Number & ". " & Err.Description
Resume errExit
Resume

End Function

Please note:

The above code is working and giving the result e.g C:\Program Files (x86)\NutriSoft\Common\Templates\Nutrition\MyWordFile.docx but i want only to show each file name e.g MyWordFile.docx
 
Do you want to remove the path from the procedure or do you want to just not see the path only the filename in the listbox?

If the latter you would adjust your column widths for the list box to hide it.

It would also help if you used code tags when posting code. Makes it much easier to read.

Code: 
Public Function ListFilesT(FolderPath As String, Optional FileSearch As String, Optional FileExt As String) As String
    '3/25/2018
    'thedbguy@gmail.com
    'optional valid file extensions should include the dot and be separated by semicolons (e.g. .txt;.docx;.xlsx;.accdb)


    On Error GoTo ErrHandler


    Dim fso As Object
    Dim fsoFolder As Object
    Dim fsoFile As Object
    Dim arrExtensions() As String
    Dim var As Variant
    Dim x As Long
    Dim strFiles As String


    'assign valid file extensions to an array
    If Not IsMissing(FileExt) Then
        arrExtensions = Split(FileExt, ";")
    End If


    Set fso = CreateObject("Scripting.FileSystemObject")


    'check for a valid path
    If fso.folderexists(FolderPath) Then
        Set fsoFolder = fso.getfolder(FolderPath)


        'process subfolders
        If fsoFolder.subfolders.Count > 0 Then
            For Each var In fsoFolder.subfolders
                'recursion
                strFiles = ";" & ListFilesT(var.Path, FileSearch, FileExt) & strFiles
            Next var
        End If


        'list files
        If fsoFolder.files.Count > 0 Then
            For Each var In fsoFolder.files
                If IsMissing(FileExt) Or FileExt = "" Then
                    'check for search keyword, if supplied
                    If FileSearch = "" Then
                        ' strFiles = ";" & var.Path & strFiles
                        strFiles = ";" & fso.GetFileName(var.Path) & strFiles ' i tried with this without result..
                    ElseIf InStr(var.Name, FileSearch) > 0 Then
                        ' strFiles = ";" & var.Path & strFiles
                        strFiles = ";" & fso.GetFileName(var.Path) & strFiles
                    End If


                Else
                    'check for valid file extensions, if supplied
                    For x = LBound(arrExtensions) To UBound(arrExtensions)
                        'skip files without file extensions
                        If InStr(var.Name, ".") > 0 Then
                            If Mid$(var.Name, InStrRev(var.Name, ".")) = arrExtensions(x) Then
                                'check for search keyword, if supplied
                                If FileSearch = "" Then
                                    ' strFiles = ";" & var.Path & strFiles
                                    strFiles = ";" & fso.GetFileName(var.Path) & strFiles
                                ElseIf InStr(var.Name, FileSearch) > 0 Then
                                    ' strFiles = ";" & var.Path & strFiles
                                    strFiles = ";" & fso.GetFileName(var.Path) & strFiles
                                End If
                            End If
                        End If
                    Next x
                End If
            Next var
        End If


    Else
        'bad folder name
        MsgBox "Folder does not exist.", vbInformation, "Invalid"


    End If


    'cleanup list (try to remove extra semicolons
    If Right$(strFiles, 1) = ";" Then strFiles = Left$(strFiles, Len(strFiles) - 1)


    'return the result
    ListFilesT = CleanList(Mid$(strFiles, 2))


errExit:
    Set fsoFolder = Nothing
    Set fso = Nothing
    Exit Function


ErrHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    Resume


End Function
 
gstylianou said:
I prefer just not see the path (only the filename in the listbox)
Click to expand...
Then in the property sheet for the listbox set the column count to 2 and set the column widths to 1";0" assuming the filename is in the first column and the path in the second.

props.png
 
moke123 said:
Then in the property sheet for the listbox set the column count to 2 and set the column widths to 1":0 assuming the filename is in the first column and the path in the second.
Click to expand...
It doesn't works because the listbox has just one column and the name is embedded (includes also the path and file name )
 
For Each var In fsoFolder.files
Your Var is not a variant but an object of Scripting.File. It has a name property

normally this is done early binding to make a lot clearer
dim fileItem as scripting.file
For Each FileItem In fsoFolder.Files

I would get rid of the name Var and use a reasonable name
dim FileItem as object
for each fileItem in fsoFolders.files
now simply use FileItem.name
 
I didn't notice that the file name is not being included in DBG's code.

you were close with
Code: 
strFiles = ";" & fso.GetFileName(var.Path) & strFiles ' i tried with this without result..

I think you need to alter all the instances with

Code: 
strFiles = ";" & fso.GetFileName(var.Path) & ";" & var.Path  & strFiles ' i tried with this without result..
 
Scripting.File has a name property and a path property. Seems very convoluted to use the path as a parameter for the filesystemobject.GetFileName method to get the name when you already have the name.
 
MajP said:
For Each var In fsoFolder.files
Your Var is not a variant but an object of Scripting.File. It has a name property

normally this is done early binding to make a lot clearer
dim fileItem as scripting.file
For Each FileItem In fsoFolder.Files

I would get rid of the name Var and use a reasonable name
dim FileItem as object
for each fileItem in fsoFolders.files
now simply use FileItem.name
Click to expand...
is it possible for you to modify the above code as it must be?
Thanks
 
Code: 
Public Function ListFilesT(FolderPath As String, Optional FileSearch As String, Optional FileExt As String) As String
    '3/25/2018
    'thedbguy@gmail.com
    'optional valid file extensions should include the dot and be separated by semicolons (e.g. .txt;.docx;.xlsx;.accdb)


    On Error GoTo ErrHandler


    Dim fso As Object
    Dim fsoFolder As Object
    Dim fsoFile As Object
    Dim arrExtensions() As String
    Dim FileItem as Object
    Dim x As Long
    Dim strFiles As String


    'assign valid file extensions to an array
    If Not IsMissing(FileExt) Then
        arrExtensions = Split(FileExt, ";")
    End If


    Set fso = CreateObject("Scripting.FileSystemObject")


    'check for a valid path
    If fso.folderexists(FolderPath) Then
        Set fsoFolder = fso.getfolder(FolderPath)


        'process subfolders
        If fsoFolder.subfolders.Count > 0 Then
            For Each FileItem In fsoFolder.subfolders
                'recursion
                strFiles = ";" & ListFilesT(FileItem.Path, FileSearch, FileExt) & strFiles
            Next FileItem
        End If


        'list files
        If fsoFolder.files.Count > 0 Then
            For Each FileItem In fsoFolder.files
                If IsMissing(FileExt) Or FileExt = "" Then
                    'check for search keyword, if supplied
                    If FileSearch = "" Then
                        ' strFiles = ";" & FileItem.Path & strFiles
                        strFiles = ";" & FileItem.name & strFiles ' i tried with this without result..
                    ElseIf InStr(FileItem.Name, FileSearch) > 0 Then
                        ' strFiles = ";" & FileItem.Path & strFiles
                        strFiles = ";" & FileItem.name & strFiles
                    End If


                Else
                    'check for valid file extensions, if supplied
                    For x = LBound(arrExtensions) To UBound(arrExtensions)
                        'skip files without file extensions
                        If InStr(FileItem.Name, ".") > 0 Then
                            If Mid$(FileItem.Name, InStrRev(FileItem.Name, ".")) = arrExtensions(x) Then
                                'check for search keyword, if supplied
                                If FileSearch = "" Then
                                    ' strFiles = ";" & FileItem.Path & strFiles
                                    strFiles = ";" & FileItem.name & strFiles
                                ElseIf InStr(FileItem.Name, FileSearch) > 0 Then
                                    ' strFiles = ";" & FileItem.Path & strFiles
                                    strFiles = ";" & FileItem.name & strFiles
                                End If
                            End If
                        End If
                    Next x
                End If
            Next FileItem
        End If


    Else
        'bad folder name
        MsgBox "Folder does not exist.", vbInformation, "Invalid"


    End If


    'cleanup list (try to remove extra semicolons
    If Right$(strFiles, 1) = ";" Then strFiles = Left$(strFiles, Len(strFiles) - 1)


    'return the result
    ListFilesT = CleanList(Mid$(strFiles, 2))


errExit:
    Set fsoFolder = Nothing
    Set fso = Nothing
    Exit Function


ErrHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    Resume


End Function
 
here's another example of listing files to a table or listing files to a listbox

Edit: I just noticed I uploaded the wrong file. The one I originally posted had a filter to only list Accdb files.

I just uploaded a corrected version with the filtering lines commented out.
 

Attachments

Last edited:
MajP said:
Public Function ListFilesT(FolderPath As String, Optional FileSearch As String, Optional FileExt As String) As String '3/25/2018 'thedbguy@gmail.com 'optional valid file extensions should include the dot and be separated by semicolons (e.g. .txt;.docx;.xlsx;.accdb) On Error GoTo ErrHandler Dim fso As Object Dim fsoFolder As Object Dim fsoFile As Object Dim arrExtensions() As String Dim FileItem as Object Dim x As Long Dim strFiles As String 'assign valid file extensions to an array If Not IsMissing(FileExt) Then arrExtensions = Split(FileExt, ";") End If Set fso = CreateObject("Scripting.FileSystemObject") 'check for a valid path If fso.folderexists(FolderPath) Then Set fsoFolder = fso.getfolder(FolderPath) 'process subfolders If fsoFolder.subfolders.Count > 0 Then For Each FileItem In fsoFolder.subfolders 'recursion strFiles = ";" & ListFilesT(FileItem.Path, FileSearch, FileExt) & strFiles Next FileItem End If 'list files If fsoFolder.files.Count > 0 Then For Each FileItem In fsoFolder.files If IsMissing(FileExt) Or FileExt = "" Then 'check for search keyword, if supplied If FileSearch = "" Then ' strFiles = ";" & FileItem.Path & strFiles strFiles = ";" & FileItem.name & strFiles ' i tried with this without result.. ElseIf InStr(FileItem.Name, FileSearch) > 0 Then ' strFiles = ";" & FileItem.Path & strFiles strFiles = ";" & FileItem.name & strFiles End If Else 'check for valid file extensions, if supplied For x = LBound(arrExtensions) To UBound(arrExtensions) 'skip files without file extensions If InStr(FileItem.Name, ".") > 0 Then If Mid$(FileItem.Name, InStrRev(FileItem.Name, ".")) = arrExtensions(x) Then 'check for search keyword, if supplied If FileSearch = "" Then ' strFiles = ";" & FileItem.Path & strFiles strFiles = ";" & FileItem.name & strFiles ElseIf InStr(FileItem.Name, FileSearch) > 0 Then ' strFiles = ";" & FileItem.Path & strFiles strFiles = ";" & FileItem.name & strFiles End If End If End If Next x End If Next FileItem End If Else 'bad folder name MsgBox "Folder does not exist.", vbInformation, "Invalid" End If 'cleanup list (try to remove extra semicolons If Right$(strFiles, 1) = ";" Then strFiles = Left$(strFiles, Len(strFiles) - 1) 'return the result ListFilesT = CleanList(Mid$(strFiles, 2)) errExit: Set fsoFolder = Nothing Set fso = Nothing Exit Function ErrHandler: MsgBox Err.Number & ". " & Err.Description Resume errExit Resume End Function
Click to expand...
Hi, unfortunally the same issue. Just let you know that i'm using the following code to call the function...
Code: 
Public Sub cmdDoSomething_Click()
On Error GoTo ErrHandler

Dim strFiles As String
Dim boolVisible As Boolean

'empty list first
Me.lstFiles.RowSource = ""
Me.txtCount.Visible = boolVisible
Me.Recalc
boolVisible = True

'then populate it
If Me.txtPath > "" Then
    strFiles = ListFiles(Me.txtPath, Nz(Me.txtSearch), Nz(Me.txtFileExt))
    If Len(strFiles) > 32750 Then 'the RowSource property is limited to 32,750 characters
        MsgBox "The number of files found exceeded the limit to display on this Listbox.", vbInformation, "Limit Exceeded"
        '3/29/2018 - commented out MsgBox and assigned limited Row Source to Listbox
        'MsgBox "Here is a sample of the list of files found: " & vbCrLf & vbCrLf & strFiles
        strFiles = Left(strFiles, 32750)
        strFiles = Left(strFiles, InStrRev(strFiles, ";") - 1)
        Me.lstFiles.RowSource = strFiles
        boolVisible = True
        
    ElseIf strFiles = "" Then
        'no files found
        Me.lstFiles.RowSource = "No " & ("'" + Me.txtSearch + "' ") & "files found" _
            & (" with file extensions '" + IIf(IsNull(Me.txtFileExt), Null, Replace(Nz(Me.txtFileExt), ";", " or ")) + "'") & "!"
        boolVisible = False
        
    Else
        'success
        Me.lstFiles.RowSource = strFiles
        
    End If
    
    Me.txtCount.Visible = boolVisible
    
Else
    'empty folder path
    MsgBox "Please select a starting folder...", vbInformation, "Select Folder"
    
End If

errExit:
    'cleanup
    Exit Sub
    
ErrHandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume errExit
    Resume
    
End Sub
 
I would find the last \ from the end using InstrRev() and then Right() function.
 
Hi. Just jumping in to let you know I saw this thread but can't contribute yet as I am away from my computer. I'll check back in later to see if I could assist. Cheers!
 
Okay, not sure if I'm too late, but I hope this still helps. I have modified the original demo from my website to include the option to list the files with the path or just the names. Good luck!
 

Attachments

theDBguy said:
theDBguy said:
Okay, not sure if I'm too late, but I hope this still helps. I have modified the original demo from my website to include the option to list the files with the path or just the names. Good luck!
Click to expand...
Good morning theDBguy and thanks for your time and the attachement. Moreover i would like to inform you that i have the remaininh result in order to view only the names of the files but there is a problem on Double Click Event. If i do this i'm getting the attached error and i cannot open the current file. Is it possible to check about that?
Click to expand...
Private Sub lstFiles_DblClick(Cancel As Integer)

fShellExecute Me.lstFiles

End Sub
Thank again
 

Attachments

  • error.JPG
    error.JPG
    24.5 KB · Views: 98
MajP said:
This works for me.
Click to expand...
Thanks. Your solution working fine but another one think if you have time please. Is it possible after the double click event on Listbox to open each current file?

Thanks again for your time
 
?
gstylianou said:
Thanks. Your solution working fine but another one think if you have time please. Is it possible after the double click event on Listbox to open each current file?

Thanks again for your time
Click to expand...
The original solution simply replaced var.path with var.name. now you will need both.
Then you will have to save the full path also. You can hide that column.
strFiles = ";" & var.Path & strFiles
To
strFiles = ";" & var.Path & ";" & var.name & strFiles
 
You must log in or register to reply here.

Similar threads

P
Loop through folder and save as Txt
Replies
10
Views
296
The_Doc_Man
The_Doc_Man
S
No of Files Count
Replies
14
Views
694
The_Doc_Man
The_Doc_Man
P
Loop gets limited
2
Replies
25
Views
1,382
Pat Hartman
P
A
Solved Auto email error needed if attachment file doesn't exist or is named incorrectly
Replies
3
Views
360
theDBguy
theDBguy
W
CSV or XLSX Bank Statement to Access module (need to import via VBA and then write back to Excel with imported flag)
Replies
14
Views
1,507
Cotswold
Cotswold

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom