Accessing sub folders in a folder

Raju Kumar Singh

New Member
Joined
Jul 12, 2017
Messages
15
Hello everyone,

I want to access all files available in a folder and its all sub folder. I have written VBA code shown below using file system object, but it is not working. Please check, what mistake is underlying.



Sub checking_files_in_multiple_folders_and_subfolders(mainpath As String)


Dim fso As Scripting.FileSystemObject
Dim fol As Scripting.Folder
Dim subfol As Scripting.Folder
Dim fil As Scripting.File
Dim mainpath As String, var1 As Byte
var1 = 1


mainpath = "D:\Excel n VBA\VBA scenarios\FSO\Recursive loop"
'**********mysht is a code name of sheet1**********
With mysht
.Range("A1").Value = "File name"
.Range("B1").Value = "File Size"
.Range("C1").Value = "Date Created"
.Range("A1").Select
End With


Set fso = New Scripting.FileSystemObject
Set fol = fso.GetFolder(mainpath)
For Each fil In fol.Files
ActiveCell.Offset(var1, 0).Value = fil.Name
ActiveCell.Offset(var1, 1).Value = fil.Size
ActiveCell.Offset(var1, 2).Value = fil.DateCreated
var1 = var1 + 1
Next fil


For Each subfol In fol.SubFolders
mypath = subfol.path
Call checking_files_in_multiple_folders_and_subfolders(subfol.path)
Next subfol
End Sub


Thanks
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,095
Office Version
2007
Platform
Windows
Try this


Code:
Option Explicit
Dim rutas As New Collection
'
Sub Listar_Archivos()
    Dim ruta As String, ext As String, h1 As Worksheet, atributos As Object, arch As Variant
    Dim fila As Long, sd As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\trabajo\archivos"        'initial folder
    ext = "xls*"                        'extension
    '
    Set h1 = Sheets(1)                  'output sheet
    h1.Columns("A:F").ClearContents
    h1.Range("A1:D1").Value = Array("Folder", "File", "Date Created", "Size")
    '
    Set atributos = CreateObject("Scripting.FileSystemObject")
    rutas.Add ruta
    Call AgregaDir(ruta)
    fila = 2
    For Each sd In rutas
        arch = Dir(sd & "\*." & ext)
        Do While arch <> ""
            h1.Cells(fila, "A").Value = sd
            h1.Cells(fila, "B").Value = arch
            h1.Cells(fila, "C").Value = atributos.GetFile(sd & "\" & arch).DateCreated
            h1.Cells(fila, "D").Value = atributos.GetFile(sd & "\" & arch).Size
            fila = fila + 1
            arch = Dir()
        Loop
    Next
    '
    Set rutas = Nothing
    Application.ScreenUpdating = True
    MsgBox "Depurar archivos", vbInformation, "ARCHIVOS"
End Sub
'
Sub AgregaDir(lpath)
    Dim SubDir As New Collection, DirFile As Variant, sd As Variant
    If Right(lpath, 1) <> "\" Then lpath = lpath & "\"
    DirFile = Dir(lpath & "*", vbDirectory)
    Do While DirFile <> "" 'add subdirectorios a collection
        If DirFile <> "." And DirFile <> ".." Then _
            If ((GetAttr(lpath & DirFile) And vbDirectory) = 16) Then _
                SubDir.Add lpath & DirFile
        DirFile = Dir
    Loop
    For Each sd In SubDir
        rutas.Add sd
        Call AgregaDir(sd)
    Next
End Sub
 

Raju Kumar Singh

New Member
Joined
Jul 12, 2017
Messages
15
Hi DanteAmor,

Thank you for the provided code.
However, I am unable to fully understand the solutions. IF possible, could you please let me know where I made mistake in my line of code.

 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,095
Office Version
2007
Platform
Windows
Hi DanteAmor,

Thank you for the provided code.
However, I am unable to fully understand the solutions. IF possible, could you please let me know where I made mistake in my line of code.


Did you try the code I sent you? It works for me.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,095
Office Version
2007
Platform
Windows
Hi, I havn't tried yet. Before that I thought to understand it.

however as you said, I will try to run it in my system and let you know.
Please, try and I'll gladly explain any questions you have in the code.
It will be easier to explain my code than to review yours, test it, correct it, understand it and then explain it to you.
 

Watch MrExcel Video

Forum statistics

Threads
1,101,851
Messages
5,483,306
Members
407,393
Latest member
GeorgeBrown

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top