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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,207
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,207
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,207
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,102,641
Messages
5,488,049
Members
407,619
Latest member
obriende

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top