How to list multiple files in multiple subfolders

[greaseman]

Does anyone out there know how I might do the following:

I have a main folder which contains many sub-folders. In turen, each subfolder contains several files. I am interested in creating a text file that within each sub-folder will list certain files in that sub-folder. Example:

"Main Folder"
"Sub-folder 1"
FileA
FileB
FileZ
"Sub-folder 2"
FileA
FileB
"Sub-folder 3"
FileA
FileB
FileZ

Pseudo-code:

Read Main Folder
Do While Sub-folders exist
Do while selected sub-folder contains files
If selected sub-folder contians FileZ then
Write selected sub-folder name to text file
Write time/date stamp to text file
else
loop to next ub-folder
end if
end do while
end do while
Close input and output

Any help offered is greatly welcome. Thank you!!

 

[Bat17]

Here is some code to play with I don't have time to hack it at the moment but if you get stuck I will try latter.
It is set to filter to XLS files at them moment and write the to a table but it will give you the principal
The main bit is the FunFindXls which loops recusivly through all the folders

Option Compare Database
Option Explicit

'Using the FSO requires setting a reference to "Microsoft Scripting Runtime".

'Module-Level Variables/Constants
Private fso As Scripting.FileSystemObject
'Change the following constants to the appropriate folder names
Const cstrXLSpath As String = "\\Murph\home$\saunderp\border"

'This sub gets the whole process started...
Sub UpdateMsdsHyperlinks()
Dim FolderXLS As Scripting.Folder
Dim errorMes As Variant
'On Error GoTo Link_Error
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDelXLFiles")
DoCmd.SetWarnings True
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderXLS = fso.GetFolder(cstrXLSpath)
funFindXLS FolderXLS
Links_Exit:
Exit Sub
Link_Error:  ' Error-handling routine.
   Select Case Err.Number  ' Evaluate error number.
      Case 3109  ' no permision to delete records.
        GoTo Links_Exit
      Case Else
        errorMes = MsgBox("Error Number " & Err.Number, vbCritical, "Code Error")
        GoTo Links_Exit
   End Select
End Sub

'This sub does all the work
Private Sub funFindXLS(FolderXLS As Scripting.Folder)
Dim SubFolderXLS As Scripting.Folder
Dim oFile As Scripting.File
Dim strFile As String
Dim dbs As Database
Dim rstXLS As Recordset

Set dbs = CurrentDb
Set rstXLS = dbs.OpenRecordset("tblXLfiles")
With rstXLS
   'For each subfolder in the main folder, run this sub recursively
   If FolderXLS.SubFolders.Count Then
        For Each SubFolderXLS In FolderXLS.SubFolders
            funFindXLS SubFolderXLS
        Next 'SubFolderXLS
   End If
   
   'scan each file in the folder and to see if it is an XLS
   For Each oFile In FolderXLS.Files
        strFile = UCase$(oFile.Name)
        If Right(strFile, 3) = "XLS" Then
            'add file here
                  .AddNew
                  !filepath = oFile.Path
                  .Update
         End If
   Next 'oFile
   .Close
End With
Set rstXLS = Nothing
Set dbs = Nothing
End Sub

HTH

Peter

 

[greaseman]

Cool! Thanks! What took you so long to reply???? I'll mess around with it and see what comes out.

Thanks again!

 

[greaseman]

Bat17,

Quick question re: the code snippet you provided:

On the lines,

Set dbs = CurrentDb
Set rstXLS = dbs.OpenRecordset("tblXLfiles")
With rstXLS

It looks like you had some sort of table with the names of your XL files in it. In my case, I won't be having a table with a list of file names. In my situation, how should I adjust the code to do the same looping function?

Thanks you so much in advance!

 

[Bat17]

I think I would still use the table to store data then treat it as a two step operation. Gat your data, then build your text page from the data.
Probably just sorting the data alphabecticaly will let you step through the records one at a time time build up the directory structure in the report.

I will try to look at it in the morning for you if you like.

Peter

 

[greaseman]

Bat 17,

I got it figured out!! Here's the code I used:


'Using the FSO requires setting a reference to "Microsoft Scripting Runtime".

'Module-Level Variables/Constants
Private fso As Scripting.FileSystemObject
'Change the following constants to the appropriate folder names
Const cstrXLSpath As String = "\\jana-dp-data\projects\honeywell-IHC"

Public Function Command3_Click()
Dim fso As New FileSystemObject
Dim f As Folder, sf As Folder, path As String, oFile As Scripting.File
Dim strfile As String
'Initialize path.
Open "c:\filelist.txt" For Output As #1
path = "\\jana-dp-data\projects\honeywell-IHC\Sundstrand Legacy Data\APCS (Files For Conversion)"
'Get a reference to the Folder object.
Set f = fso.GetFolder(path)
'Iterate through subfolders.
For Each sf In f.SubFolders
Print #1, sf.Name, " ", sf.DateCreated
For Each oFile In sf.Files
If oFile.Name Like "*Legacy*" Then Print #1, " ", oFile.Name, " ", oFile.DateCreated
If oFile.Name Like "*Master*" Then Print #1, " ", oFile.Name, " ", oFile.DateCreated
If sf.Name Like "*762*" Then GoTo EndProcess
Next
Next
EndProcess:
Close #1
End Function



And that's it! Unfortunately, I don't know how to cut and paste nicely formatted code into a note or a reply on this forum, so apologies in advance for what looks to be sloppy code.

Thanks for your replies and for your willingness to help......it's appreciated.

 

[Bat17]

Glad you got it sorted
To post code use
[ code ] Your code goes here [ /code ]
But without the extra spaces that I put around the brackets to make them show in the window!

Peter

 

[Bat17]

Having had a look at your code, you are not using the function recusivly anymore so it will only look one subfolder deep, which is fine if your data will never go over one deep.
Peter