Get File names from a sub folders sub folder

[JohnLee]

Good afternoon,

I have some help with an earlier post to do with obtaining the names of files in subfolders, however I've just discovered that there are to be subfolders for the subfolders from which I will need to extract file names! I'm at a loss of how to modify the below code to drill down another level.
Below is the code that I got from this forum that I have used to get my first level subfolder file names, could someone assist me with how I need to amend this code to get to the next subfolder level down:

Dim fso    As Object
    Dim fldr   As Object
    Dim sbfldr As Object
    Dim f      As Object
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder(UserPath)
 
    For Each f In fldr.Files
        If Right(f.Name, 3) = "mdb" Or Right(f.Name, 5) = "accdb" Then
            Debug.Print f.Path
        End If
    Next
 
    For Each sbfldr In fldr.SubFolders
        For Each f In sbfldr.Files
            If Right(f.Name, 3) = "mdb" Or Right(f.Name, 5) = "accdb" Then
                Debug.Print f.Path
            End If
        Next
Next

Folder structure will be as follows:

Top Level Folder
sub Folder
sub sub Folder

i.e.
Archiving [top level folder]
Instant Take Ups [sub folder]
Batch Date [sub sub folder]

Any help would be most appreciated.

John

 

[JamesMcS]

That looks familliar

I think you could just do this with the one for each... statement, and a recordset. For each folder, append the folder path to a recordset. move next in the recordset and repeat until end of recordset.

The recordset will continually have records appended to it while subfolders exist. But when there aren't any more subfolders to append, the routine will eventually reach EOF and will exit.

 

[JohnLee]

Hi James,

The code works but only to one subfolder level, as there is another subfolder level within the subfolder, I need to be able to get down another level. I've been reading and searching stuff in this forum and the internet in general, but not having much luck in finding anything that tackles going down another folder level, everything I've read so far only goes to Folder and then sub folder level.

I think the code I got from this forum and modified for my own use is in the general area of what I need, and I've tried looking for information in VBA for sub sub folder objects, but found nothing.

Do you have any information that might help me identify what I need to read up on to get down to the next level of sub folders.

It did cross my mind your suggestion of writing code for each sub sub folder level, but the problem is I won't know the names of the sub folders or sub sub folders until they've been created and they will be created daily dynamically by our scanning system. which is why I am trying to work out hour to get down to the next level.

Your assistance is appreciated.

John

 

[JamesMcS]

I'm just having a muck about with my method above, not sure if it'll work at the moment. In the meantime Allen Browne has put a module together - if you google 'list files recursively' you might be able to adapt his code a bit..l.

 

[JohnLee]

Hi James,

Thanks for the pointer, I will have a look now.

John

 

[gemma-the-husky]

the sort of RECURSIVE logic you want is illustrated in the pseudocode listed below. I hope it makes sense. Recursion makes something like this very simple.

HOWEVER, The problem is determining how you can iterate the files in a given folder. You can't use DIR() as this is not recursive. Not sure if fso routines permit recursion.

sub listfiles(root as string)

for each file in folder pointed to by root
  if its a folder then
[COLOR="Red"]     'recursion - repeat this process for the next folder down
     'the procedure calls ITSELF![/COLOR]     
     listfiles(newfile)
 else
    process the file
next
end sub

sub main
   listfiles (rootfolder)
end sub

 

[JamesMcS]

This seems to work OK:

Sub Create_Dir_List(Inputpath As String)
Dim Dbs As Database
Dim Rst As DAO.Recordset
Dim Fso, Fldr, SubFldr, F As Object
Dim lastpos As Integer


Set Dbs = CurrentDb
Set Rst = Dbs.OpenRecordset("tblCreate_Dir_List", dbOpenDynaset)

Set Fso = CreateObject("scripting.filesystemobject")
Set Fldr = Fso.getfolder(Inputpath)

    With Rst
    
        .AddNew
        .Fields("Filepath") = Fldr.Path
        .Update
    
    End With

For Each Fldr In Fldr.subfolders

Call Create_Dir_List(Fldr.Path)

Next Fldr

End Sub

You need to create a table called tblCreate_Dir_List. Try calling it from the immediate window like this:

call create_dir_list("Enter path here")

Thanks to Bob Larson for pointing me in the right direction with this

 

[JohnLee]

Good morning Folks,

Thank you all for your pointers and assistance, I'll let you know how I get on.

This Forum rocks

John

 

[JamesMcS]

Sorry John, the code above only lists folders. This lists the files. Create a table "tblCreate_File_List" with text fields DIrpath, Filepath, Filename. Call as above.

Sub Create_File_List(Inputpath As String)
Dim Dbs As Database
Dim rst As DAO.Recordset
Dim Fso, Fldr, SubFldr, F As Object

Set Dbs = CurrentDb
Set rst = Dbs.OpenRecordset("tblCreate_File_List", dbOpenDynaset)

Set Fso = CreateObject("scripting.filesystemobject")
Set Fldr = Fso.getfolder(Inputpath)

For Each F In Fldr.files
    
    If Right(F.Name, 3) = "mdb" Or Right(F.Name, 5) = "accdb" Then
    
        With rst
    
            .AddNew
            .Fields("Dirpath") = Fldr.Path
            .Fields("Filepath") = F.Path
            .Fields("Filename") = F.Name
            .Update
    
        End With
    
    End If
    
Next F

For Each Fldr In Fldr.subfolders

Call Create_File_List(Fldr.Path)

Next Fldr

End Sub

I've been using another sub to delete the contents of the table, then call the routine.

 

[JohnLee]

Hi James,

I've tried your code, but I keep getting a Run-Time error 3048, can not open anymore databases! as I only have the one database open, I don't understand why I keep getting this error message.

I'll do a search on the internet to see what I can find about this error message, but if you have any ideas any help would be appreciated.

John

 

[gemma-the-husky]

this is probably the problem - as this is inside the sub,, it keeps getting called for every subfolder, and never gets destroyed. This ought to be declared outside the recursive sub, so it only gets declared once

Set Dbs = CurrentDb
Set rst = Dbs.OpenRecordset("tblCreate_File_List", dbOpenDynaset)

 

[JohnLee]

Hi Gemma,

Thanks for the pointer.

John

 

[gemma-the-husky]

Dim Fso, Fldr, SubFldr, F As Object

one other thing - this is not quite accurate in VBA.

it may be OK, but only variable f is defined as an object, in this instance.
the other three are treated as variants, which may or may not be the same.

we normally put variables on separate lines in VBA.


dim fso as object
dim fldr as object etc

dim fso as object, Fldr as object, SubFldr as object etc is also OK.

 

[JamesMcS]

Oh.... Bob Larson, provider of the original bit of code that I developed upon, did have them on separate lines. I didn't realise it didn't do them all...!

Still works OK on mine though, unless a folder isn't shared with everyone, then it throws an error up. I guess if I ran the routine on a bigger folder I'd eventually come up with the same error.

 

[JohnLee]

Hi Gemma,

Thanks for that, could be part of my problem. still working on it.

John

 

[JamesMcS]

So having the recordset and db declarations outside the routine is still causing problems?

 

[JohnLee]

Hi James/Gemma,

I've been also looking at the Allen Browne code which James pointed me to earlier to see if I can understand where I'm going wrong, It would appear I've gotten myself in a bit of a mess and so I'm going to start this part of my project from scatch using all the information and guidance you've both given me.

I'm also going to be referring to Allen Browne code and hopefully I will get there, please bear with me.

Thanks once again

John

 

[gemma-the-husky]

OK here's a fully tested version -

it needs a table called

tblfiles, with fields

folder, string 255
filename, string 255

It has some error checking. When I tried to run this on my disk D: it threw an error on folder "D:\ system volumn information" - so I added some error-checking

Option Compare Database
Option Explicit

Dim db As Database
Dim rst As Recordset
Dim files As Long

[COLOR="Red"]'This is the recursive folder tree walker sub[/COLOR]

sub listfiles(root As String)

Dim fname As String
Dim Fso As Object, Fldr As Object, SubFldr As Object, F As Object

If Right(root, 1) <> "\" Then root = root & "\"  [COLOR="red"]'just in case there is no trailing \[/COLOR]

Set Fso = CreateObject("scripting.filesystemobject")
Set Fldr = Fso.GetFolder(root)[COLOR="red"] 'use this current folder[/COLOR]

   [COLOR="red"] 'now iterate the files - error handler just in case[/COLOR]
    On Error GoTo failFILE
    For Each F In Fldr.files
       [COLOR="red"]'append any file to the table[/COLOR]        
        rst.AddNew
        rst!folder = root
        rst!filename = F.Name
        rst.Update
        files = files + 1
nextfile:
    Next
 
   [COLOR="red"] 'now iterate the folders - error handler just in case[/COLOR]
    On Error GoTo failFOLDER
    For Each SubFldr In Fldr.SubFolders
       listfiles (root & SubFldr.Name)
nextfolder:
    Next

Exit Sub

failFILE:
    MsgBox ("Unable to examine file in folder " & root & vbCrLf & _
        "Error: " & Err & "  Desc: " & Err.Description)
    Exit Sub
    Resume nextfile

failFOLDER:
    MsgBox ("Unable to examine folder " & root & vbCrLf & _
        "Error: " & Err & "  Desc: " & Err.Description)
[COLOR="Red"]   'Note I aborted here with exit sub, rather than continue the loop - 
   'when I tried it, I got a problem trying to continue the loop, 
   'with the fso loop dropping out of scope.
    Exit Sub
    Resume nextfolder

End Sub



Sub main()
Set db = CurrentDb
Set rst = db.OpenRecordset("tblFiles", dbOpenDynaset)
files = 0

listfiles ("D:\")

rst.Close
Set rst = Nothing
Set db = Nothing

MsgBox ("Finished: " & files & " files found. ")

End Sub

 

[JamesMcS]

Yeah, that'll be the rights thing I was talking about I expect. Mine fell over on one of the system restore folders. I suppose you could always make it check the file attributes and ignore hidden folders, unless you needed them listed....

 

[JohnLee]

Hi Gemma,

I've deployed your code, however I'm getting a type mismatch error in the following line of code

Set rst = db.OpenRecordset("tblFiles", dbOpenDynaset)

I've checked the field names and the data types for the following fields

folder is set to text and will allow upto 255 characters
filename is set to text and will allow upto 100 characters

I'm not sure what I should be looking for to resolve the problem, any suggestions.

Thanks

John

PS Both fields are now set to 255 length, but the same error message is coming up.

John