Fill the listbox only with file name (1 Viewer)

G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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
 
moke123

moke123

AWF VIP
Local time
Today, 02:44
Joined
Jan 11, 2013
Messages
3,920
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
 
moke123

moke123

AWF VIP
Local time
Today, 02:44
Joined
Jan 11, 2013
Messages
3,920
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
 
G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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 )
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 02:45
Joined
May 21, 2018
Messages
8,529
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
 
moke123

moke123

AWF VIP
Local time
Today, 02:44
Joined
Jan 11, 2013
Messages
3,920
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..
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 02:45
Joined
May 21, 2018
Messages
8,529
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.
 
G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 02:45
Joined
May 21, 2018
Messages
8,529
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
 
moke123

moke123

AWF VIP
Local time
Today, 02:44
Joined
Jan 11, 2013
Messages
3,920
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

  • ListFilesTableListbox.accdb
    740 KB · Views: 84
Last edited:
G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 07:45
Joined
Sep 21, 2011
Messages
14,299
I would find the last \ from the end using InstrRev() and then Right() function.
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 02:45
Joined
May 21, 2018
Messages
8,529
This works for me.
 

Attachments

  • TestSpan.accdb
    736 KB · Views: 98
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 23:45
Joined
Oct 29, 2018
Messages
21,473
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!
 
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 23:45
Joined
Oct 29, 2018
Messages
21,473
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

  • theDBguyListFilesDemoV1.2.zip
    44.2 KB · Views: 75
G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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: 60
G

gstylianou

Registered User.
Local time
Today, 09:44
Joined
Dec 16, 2013
Messages
357
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
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 02:45
Joined
May 21, 2018
Messages
8,529
?
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

S
No of Files Count
Replies
14
Views
440
The_Doc_Man
The_Doc_Man
P
Loop gets limited
2
Replies
25
Views
890
Pat Hartman
P
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,058
Cotswold
Cotswold
K
How i can i save the captured image with specific location folder?
Replies
14
Views
937
Kamayo Ako
K
N
Solved Mass Importing Txt Files
Replies
14
Views
401
ebs17
E

Users who are viewing this thread

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