list files in folder and sub-folder

[howard]

I have the following code to list all files in a folder



I have tried to amend this to list all files in the folder and sub-folder C:\extract for eg C:\extract\TBBr1 containing the name Man(P) in the workbook name


Your assistance in resolving this is most appreciated

 Sub ListFilesinFolder()

Sheets("Sheet1").Select
Range("A1:C150").ClearContents
Dim fso As Object, Fld As Object, fPath As String, Ct As Long
Set fso = CreateObject("Scripting.Filesystemobject")
fPath = "C:\extract"
Set Fld = fso.getfolder(fPath).Files
Application.ScreenUpdating = False
Range("A1:C1").Value = Array("File Name", "Created", "Last Modified")
For Each F In Fld
    Ct = Ct + 1
    Range("A1").Offset(Ct).Value = F.Name
    Range("B1").Offset(Ct).Value = F.datecreated
    On Error Resume Next
    Range("C1").Offset(Ct).Value = F.DateLastModified
    On Error GoTo 0
Next F


Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("B:B").Delete


Columns("A:C").AutoFit
Application.ScreenUpdating = True
End Sub

 

[jbeaucaire]

This is the technique I use to run a given macro on every subfolder from starting folder. This method will dive down as deep as any subfolders go.

1) A "start" macro the initiates everything and feeds a beginning folder into the LoopController.

2) A "LoopController" macro that simply calls the main macro feeding in the current target folder.

3) The "Main Macro" is the guts of your original macro, it takes the incoming path and runs its normal routine on all the files in the one folder.

When 3 is done, hen the LoopController gets control back, looks for a subfolder in the current folder, dives in there and calls the main macro again with the found subfolder.

If that subfolder has subs of its own, then when the main macro is done the LoopController will check those, too. It gets them all.

Option Explicit

Sub ListStarter()

Sheets("Sheet1").Range("A1:C150").ClearContents
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1:C1").Value = Array("File Name", "Created", "Last Modified")

LoopController ("C:\Extract")
Sheets("Sheet1").Columns.AutoFit

End Sub

Private Sub LoopController(sSourceFolder As String)
'This will loop into itself, first processing the files in the folder
'then looping into each subfolder deeper and deeper until all folders processed
Dim Fldr As Object, FL As Object, SubFldr As Object

    Call ListFilesinFolder(sSourceFolder & Application.PathSeparator)

    Set Fldr = CreateObject("Scripting.FileSystemObject").Getfolder(sSourceFolder)
    For Each SubFldr In Fldr.SubFolders
        LoopController SubFldr.Path
    Next

End Sub

Sub ListFilesinFolder(MyPath As String)
Dim fso As Object, f As Object, Fld As Object, NR As Long

NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fld = fso.Getfolder(MyPath).Files

For Each f In Fld
    NR = NR + 1
    Sheets("Sheet1").Range("A" & NR).Value = f.Name
    Sheets("Sheet1").Range("B" & NR).Value = f.DateCreated
    On Error Resume Next
    Sheets("Sheet1").Range("C" & NR).Value = f.DateLastModified
    On Error GoTo 0
Next f

End Sub

 

[howard]

Hi Jerry

Thanks for your code, much appreciated

It would be appreciated if you would amend your code just to list the .xls files that contains "MAN(P) in the name for eg BR1 Man (P).xls



Howard

 

[howard]

Hi Jerry

What I am trying to do, is to list the files names on all the files in C:\extract and its sub-folders into sheet "workspace" for workbooks containing in the name MAN (P).xls for eg Br1 Man (P).xls

I then want to use a macro to open these files, but It does not open any files

It would be appreciated if you could assist

 Sub Open_Files()

Sheets("Workspace").Select

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim c As Range, fPath As String
            fPath = "C:\extract\"
            
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   Workbooks.Open (fPath & c.Value & ".xls")
              
           
  Next c
         

    
    Application.ScreenUpdating = True
     Application.DisplayAlerts = True
End Sub

 

[jbeaucaire]

Opening and "doing stuff" to a files is a whole 'nother puzzle. For the purposes of completing this original thread's point, this tweak will list only .xls files with the word MAN in the title somewhere:

For Each f In Fld
    If Instr(f.Name, "MAN") > 0 And Right(f.Name, 4) = ".xls" Then
        NR = NR + 1
        Sheets("Sheet1").Range("A" & NR).Value = f.Name
        Sheets("Sheet1").Range("B" & NR).Value = f.DateCreated
        On Error Resume Next
        Sheets("Sheet1").Range("C" & NR).Value = f.DateLastModified
        On Error GoTo 0
    End If
Next f

You should be able to edit this to your exact specifications.

 

[howard]

Thanks Jerry, code works perfectly

 

[howard]

I have now written code to open the .xls files where the file names appear on sheet "Workspace" for eg BR1 ACCNTS (P), but no workbooks open when activating the code


However, if I copy the workbooks that are in the sub-directories of C:\extract and thwn run the macro, the workbooks open , but the code does not open the files containing the name ACCNTS (P) from the sub-folders.

It would be appreciated if you would amend my code

See my code below

 Sub Open_Files()

Sheets("Workspace").Select    

    Dim rngCell As Range
    Dim zFPath  As String
    Dim zFSpec  As String
     Dim Folder As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    zFPath = "C:\extract\"      
       Folder = Dir(zFPath, vbDirectory)

    For Each rngCell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
       zFSpec = zFPath & Folder & rngCell.Value & ".xls"
       Workbooks.Open zFSpec
    
    Next rngCell
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub

 

[howard]

Hi Jerry

I have amended my code and not it only opens up one of the files in the Sub-folder where the name appears on sheet "Workspace"

It would be appreciated if you could assist me

   Sub Open_Test()

 Dim rngCell As Range
    
    
Dim zPATH As String:    zPATH = "C:\extract\"
Dim FSO As Object:      Set FSO = CreateObject("Scripting.FileSystemObject")
Dim FLD As Object:      Set FLD = FSO.GetFolder(zPATH)
Dim SubFLDRS As Object: Set SubFLDRS = FLD.SubFolders
Dim SubFLD As Object

Dim wbData As Workbook


Application.ScreenUpdating = False
 On Error Resume Next
For Each SubFLD In SubFLDRS

  For Each rngCell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    Set wbData = Workbooks.Open(zPATH & SubFLD.Name & "\" & rngCell.Value & ".xls")
    
    
    
    Next rngCell
    Next SubFLD

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    
End Sub

 

[jbeaucaire]

Post #2 is the best I can offer for the topic of this thread. As you move on to other topics, new threads would be in order. You can provide links to this thread if you think it relevant in your new topics.

 

[howard]

Hi Jerry

No problem. Will post on new thread