VBA to run a list all folder & subfolder content with column headers

X

xcellrodeo

Board Regular
Joined
Oct 27, 2008
Messages
209
Hi, I wonder if I could ask for some help from some very intelligent people out there.
I would like some help with creating a VBA script that returns a complete list of folders and subfolder content in a given location.
The starting point could be a text box which opens and the user has to enter a full file path which the VBA will then run from and return the results in Tab "List Details".
In the 'List Details' tab, I would like the VBA search results to be organised under the column headers in the format below:

Column A -> File Name:
Column B -> File Path:
Column C -> Folder Name (where file is located):
Column D -> Sub Folder Name (where file is located):
Column E -> File Ext (i.e jpg, xls, pdf...) :
Column F -> Date last modified:

Any help with the above would be greatly appreciated.
Thanks
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
cant seem to upload the workbook.
paste the code below into a module
B1 : put the starting folder name, ex: c:\temp
B2 : put the file code of the type of files to find: *=all, X=excel, A=access, W=word
B3 : put Y to search in subfolders

run macro: GetFileList


Code: 
Option Explicit
'by Randy Pack to collect files of certain types (or all) in folder
'v210503  subfolder

Public gvTypCode
Public gcolIgnorDirs As Collection
Public Const kCELLstartDir = "B1"
Public Const kCELLfileType = "B2"
Public Const kCELLuseSubDir = "B3"
Public gbUseSubDirs As Boolean

Public Sub ScanSubfolders(ByVal pvStartDir)
Dim FileSystem As Object

Range("A2").Select
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(pvStartDir)

Set FileSystem = Nothing
End Sub
Sub DoFolder(Folder)
Dim SubFolder
Dim oFile
Dim fso
Dim i As Integer

Set fso = CreateObject("Scripting.FileSystemObject")
'Set Folder = fso.GetFolder(Folder)

    For Each SubFolder In Folder.SubFolders
        'Debug.Print SubFolder
        'For i = 1 To gcolIgnorDirs.Count
        '   If InStr(vDir, gcolIgnorDirs(i)) > 0 Then GoTo skipDir
        'Next
      
    
        DoFolder SubFolder
skipDir:
    Next
  
       'list each file in folder
    For Each oFile In Folder.Files
            ' Operate on each file
        'Debug.Print Folder, oFile.Name, oFile.DateLastModified
      
       If oFile.Name = "FAILURE ANALYSIS 2010_Backup.mdb" Then
          Beep
       End If
   
           ' Debug.Print oFile.Name
        If IsCorrectFileType(oFile.Name) Then
            ActiveCell.Offset(0, 0).Value = oFile.Name   'filename
            ActiveCell.Offset(0, 1).Value = oFile       'filename  & name
            ActiveCell.Offset(0, 2).Value = Folder    'folder name
            'ActiveCell.Offset(0, 3).Value = Folder  'same as above
            ActiveCell.Offset(0, 4).Value = Mid(oFile.Name, InStrRev(oFile.Name, ".") + 1) 'folder
            ActiveCell.Offset(0, 5).Value = oFile.datelastModified              'date last mod
          
            ActiveCell.Offset(1, 0).Select  'next row
        End If
skip1:
    Next
  
Set oFile = Nothing
Set SubFolder = Nothing
End Sub

Public Sub ScanFilesIn1Folder(ByVal pvStartDir)
Dim FileSystem As Object
Dim Folder As Object
Dim oFile As Object

Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set Folder = FileSystem.GetFolder(pvStartDir)

Range("A2").Select
For Each oFile In Folder.Files
    If InStr(oFile.Name, "backup") > 0 Then GoTo skip1
  
    If IsCorrectFileType(oFile.Name) Then       'If InStr(oFile.Name, ".accdb") > 0 Or InStr(oFile.Name, ".mdb") > 0 Then
        ActiveCell.Value = oFile
        ActiveCell.Offset(1, 0).Select  'next row
    End If
  
skip1:
Next

Set oFile = Nothing
Set Folder = Nothing
Set FileSystem = Nothing
End Sub



Public Function IsCorrectFileType(ByVal pvFile) As Boolean
'If InStr(LCase(pvFile), "backup") > 0 Then
Dim vWord

Select Case UCase(gvTypCode)
   Case "A"
     IsCorrectFileType = (InStr(pvFile, ".accdb") > 0) Or (InStr(pvFile, ".mdb") > 0)
   
   Case "X"
     IsCorrectFileType = InStr(pvFile, ".xls") > 0
 
   Case "W"
     IsCorrectFileType = InStr(pvFile, ".doc") > 0
 
   Case "T"
     IsCorrectFileType = InStr(pvFile, ".txt") > 0
 
   Case "*", "" 'all files
     IsCorrectFileType = True
End Select
End Function


Public Sub LoadIgnorDir()
Set gcolIgnorDirs = New Collection
Sheets("Ignore").Select
Range("A2").Select
While ActiveCell.Value <> ""
   gcolIgnorDirs.Add ActiveCell.Value
   ActiveCell.Offset(1, 0).Select 'next row
Wend
Sheets(1).Select
End Sub


Public Sub GetFileList()
Dim fso
Dim vStartDir
Dim wsTarg As Worksheet, wsMain As Worksheet

Set wsMain = ActiveSheet
vStartDir = Range(kCELLstartDir).Value
gvTypCode = Range(kCELLfileType).Value
gbUseSubDirs = UCase(Range(kCELLuseSubDir).Value) = "Y"


Set fso = CreateObject("Scripting.FileSystemObject")

  'clear
'LoadIgnorDir
'Range("A2:B600").ClearContents
  'set vals
Sheets.Add
Set wsTarg = ActiveSheet
wsTarg.Activate
Range("A1").Value = "Filename"
Range("b1").Value = "Filepath"
Range("c1").Value = "folder"
Range("d1").Value = "subfolder"
Range("e1").Value = "File ext"
Range("f1").Value = "last modified date"

Range("A2").Select

If gbUseSubDirs Then
   DoFolder fso.GetFolder(vStartDir)
Else
   ScanFilesIn1Folder vStartDir
End If

Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
MsgBox "Done"
End Sub
 
Upvote 0
ranman256 said:
cant seem to upload the workbook.
paste the code below into a module
B1 : put the starting folder name, ex: c:\temp
B2 : put the file code of the type of files to find: *=all, X=excel, A=access, W=word
B3 : put Y to search in subfolders

run macro: GetFileList


Code: 
Option Explicit
'by Randy Pack to collect files of certain types (or all) in folder
'v210503  subfolder

Public gvTypCode
Public gcolIgnorDirs As Collection
Public Const kCELLstartDir = "B1"
Public Const kCELLfileType = "B2"
Public Const kCELLuseSubDir = "B3"
Public gbUseSubDirs As Boolean

Public Sub ScanSubfolders(ByVal pvStartDir)
Dim FileSystem As Object

Range("A2").Select
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(pvStartDir)

Set FileSystem = Nothing
End Sub
Sub DoFolder(Folder)
Dim SubFolder
Dim oFile
Dim fso
Dim i As Integer

Set fso = CreateObject("Scripting.FileSystemObject")
'Set Folder = fso.GetFolder(Folder)

    For Each SubFolder In Folder.SubFolders
        'Debug.Print SubFolder
        'For i = 1 To gcolIgnorDirs.Count
        '   If InStr(vDir, gcolIgnorDirs(i)) > 0 Then GoTo skipDir
        'Next
     
   
        DoFolder SubFolder
skipDir:
    Next
 
       'list each file in folder
    For Each oFile In Folder.Files
            ' Operate on each file
        'Debug.Print Folder, oFile.Name, oFile.DateLastModified
     
       If oFile.Name = "FAILURE ANALYSIS 2010_Backup.mdb" Then
          Beep
       End If
  
           ' Debug.Print oFile.Name
        If IsCorrectFileType(oFile.Name) Then
            ActiveCell.Offset(0, 0).Value = oFile.Name   'filename
            ActiveCell.Offset(0, 1).Value = oFile       'filename  & name
            ActiveCell.Offset(0, 2).Value = Folder    'folder name
            'ActiveCell.Offset(0, 3).Value = Folder  'same as above
            ActiveCell.Offset(0, 4).Value = Mid(oFile.Name, InStrRev(oFile.Name, ".") + 1) 'folder
            ActiveCell.Offset(0, 5).Value = oFile.datelastModified              'date last mod
         
            ActiveCell.Offset(1, 0).Select  'next row
        End If
skip1:
    Next
 
Set oFile = Nothing
Set SubFolder = Nothing
End Sub

Public Sub ScanFilesIn1Folder(ByVal pvStartDir)
Dim FileSystem As Object
Dim Folder As Object
Dim oFile As Object

Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set Folder = FileSystem.GetFolder(pvStartDir)

Range("A2").Select
For Each oFile In Folder.Files
    If InStr(oFile.Name, "backup") > 0 Then GoTo skip1
 
    If IsCorrectFileType(oFile.Name) Then       'If InStr(oFile.Name, ".accdb") > 0 Or InStr(oFile.Name, ".mdb") > 0 Then
        ActiveCell.Value = oFile
        ActiveCell.Offset(1, 0).Select  'next row
    End If
 
skip1:
Next

Set oFile = Nothing
Set Folder = Nothing
Set FileSystem = Nothing
End Sub



Public Function IsCorrectFileType(ByVal pvFile) As Boolean
'If InStr(LCase(pvFile), "backup") > 0 Then
Dim vWord

Select Case UCase(gvTypCode)
   Case "A"
     IsCorrectFileType = (InStr(pvFile, ".accdb") > 0) Or (InStr(pvFile, ".mdb") > 0)
  
   Case "X"
     IsCorrectFileType = InStr(pvFile, ".xls") > 0

   Case "W"
     IsCorrectFileType = InStr(pvFile, ".doc") > 0

   Case "T"
     IsCorrectFileType = InStr(pvFile, ".txt") > 0

   Case "*", "" 'all files
     IsCorrectFileType = True
End Select
End Function


Public Sub LoadIgnorDir()
Set gcolIgnorDirs = New Collection
Sheets("Ignore").Select
Range("A2").Select
While ActiveCell.Value <> ""
   gcolIgnorDirs.Add ActiveCell.Value
   ActiveCell.Offset(1, 0).Select 'next row
Wend
Sheets(1).Select
End Sub


Public Sub GetFileList()
Dim fso
Dim vStartDir
Dim wsTarg As Worksheet, wsMain As Worksheet

Set wsMain = ActiveSheet
vStartDir = Range(kCELLstartDir).Value
gvTypCode = Range(kCELLfileType).Value
gbUseSubDirs = UCase(Range(kCELLuseSubDir).Value) = "Y"


Set fso = CreateObject("Scripting.FileSystemObject")

  'clear
'LoadIgnorDir
'Range("A2:B600").ClearContents
  'set vals
Sheets.Add
Set wsTarg = ActiveSheet
wsTarg.Activate
Range("A1").Value = "Filename"
Range("b1").Value = "Filepath"
Range("c1").Value = "folder"
Range("d1").Value = "subfolder"
Range("e1").Value = "File ext"
Range("f1").Value = "last modified date"

Range("A2").Select

If gbUseSubDirs Then
   DoFolder fso.GetFolder(vStartDir)
Else
   ScanFilesIn1Folder vStartDir
End If

Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
MsgBox "Done"
End Sub
Click to expand...
Hi ranman256, thank you for your very comprehensive script ;-).
However, would you please be able to give me some further guidance on where in the script I need to enter the following?

B1 : put the starting folder name, ex: c:\temp
B2 : put the file code of the type of files to find: *=all, X=excel, A=access, W=word
B3 : put Y to search in subfolders

Thnks
 
Upvote 0
in the main tab:
B1 is the starting folder you want to scan
if you only want to search for Excel files then put an X in B2. if you want ALL files, put *
put Y in B3.
 
Upvote 0
I also want this to work for me but am getting hung up.
I've substituted my starting directory for B1, placing G:\Music inside the quotation marks
I've put * for B2 and Y for B3
Running macro I get "runtime error 1004 Method 'Range' of object '_Global' failed" and the yellow highlight of line:
vStartDir = Range(kCELLstartDir).Value
any ideas?
 
Upvote 0
This is a very powerful tool. Thank you. But what if I just need the subfolders? I don't need the list of all the files in it. How would you amend the code?
 
Upvote 0
msleo16 said:
This is a very powerful tool. Thank you. But what if I just need the subfolders? I don't need the list of all the files in it. How would you amend the code?
Click to expand...
I never got this to work for me but what I did get to work was a power query. Really easy.
Open a blank workbook. Go to Data tab, Get Data, From File, From Folder, choose your folder, then at bottom of the preview box choose Load, Load again. Let it do its thing and then when all the info is loaded into your sheet filter out just the things you want to see.
 
Upvote 0
Zot said:
You can refer to the link below. This is very good example I think:

List the Files in a Folder and its SubFolders using the FileSystemObject | xl-central.com

List the files in a folder and its subfolders using the FileSystemObject in Excel VBA.
www.xl-central.com
Click to expand...
tried this and got error: Compile Error: User-defined type not defined
and it highlighted
Sub RecursiveFolder(ByRef oFolder As Scripting.Folder, ByRef aFiles() As String, _
ByRef lFileCnt As Long, ByRef bIncludeSubFolders As Boolean)
but highlight didn't include the last bracket: )

edit: all good , I forgot to set the scripting reference
 
Upvote 0
keithmct said:
tried this and got error: Compile Error: User-defined type not defined
and it highlighted
Sub RecursiveFolder(ByRef oFolder As Scripting.Folder, ByRef aFiles() As String, _
ByRef lFileCnt As Long, ByRef bIncludeSubFolders As Boolean)
but highlight didn't include the last bracket: )
Click to expand...
The code is using early binding. You need to set Reference with Microsoft Scripting Runtime before running the macro?
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Permision Denied-VBA Code to list sub-folders
Replies
4
Views
122
howard
H
H
  • Question Question
Macro to List Folders excluding Data Stamp within E:\Cobian
Replies
0
Views
73
howard
H
R
  • Question Question
VBA copying files from multiple subfolders according to a list
Replies
1
Views
133
John_w
J
G
  • Question Question
remove columns from multiple Excel-files in a folder
Replies
5
Views
335
gjvv
G
P
  • Solved
VBA to insert filename in a new column for all files in a folder
Replies
2
Views
131
psion2600
P

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top