List Files (Including Extended Windows File Attributes) with Sub-Directories in MS Excel using VBA

List Files (Including Extended Windows File Attributes) with Sub-Directories in MS Excel using VBA

What it’s All About

The be clear and straight-forward from the beginning, I do not know VBA. My coding experience outside of HTML and SQL is entirely Python, R, and C/C++ (and C/C++ was long enough ago as to be another lifetime). But when I needed to make a list of all of my Bureau’s data files while still working without software beyond the basic build (I have browsers and MS Office), and without access to any useful utilities or the ability to install anything, I turned to VBA as a possible solution.

The most important nuance of my task is that I needed the authors attribute from the extended Windows file information (this is different from the normal author/owner file attribute that, in my case, showed a generic account for the Bureau that provisions the servers, and not the creator of the file like I needed. I found lots of examples online of code that made a list of all of the files in a folder. A few of them accessed the attributes I needed. I found a couple working examples of VBA that listed all of the files in a folder and all of its sub-folders. What I wasn’t able to find was an example of code that lists out all of the files in a folder and its subdirectories AND accessed the attributes I wanted.

I know enough about coding, in general, and I have access to Google, so I was able to put together something that mostly works, using bits from all of the various examples I found. I apologize to all those on Stack Exchange and elsewhere that contributed code that I absorbed into my mess: it didn’t occur to me to track authors for attribution until I had already long lost track of what pieces came from where.

Like I said, the whole thing is a mess, and breaks in strange places. And there is a weird “feature” that makes the list start back at the beginning of the spreadsheet once it reaches 65k records. But in case someone out there is struggling to accomplish the same thing that I was, here is the code I came up with:

Sub file_list()

Call ListFilesInFolder("Z:\Test_Folder", True)

End Sub

Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim ObjectFolder As Object
Dim ObjectShell As Object
Dim FileItem As Object
Dim ObjectFolderItem As Object
Dim i As Long
Dim ws As Worksheet
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjectShell = CreateObject("Shell.Application")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1

Range("A1:G1").Value = Array("File Name", "Extension", "Path", "Date Created", "Date Modified", "Author", "Size")

For Each FileItem In SourceFolder.Files

  Set ObjectFolder = ObjectShell.Namespace(SourceFolder.Path)
  Set ObjectFolderItem = ObjectFolder.ParseName(FileItem.Name)
  Cells(r, 1).Value = ObjectFolder.GetDetailsOf(ObjectFolderItem, 0) 'File Name
  Cells(r, 2).Value = FSO.GetExtensionName(ObjectFolderItem) 'Extension
  Cells(r, 3).Value = SourceFolder.Path 'Path
  Cells(r, 4).Value = ObjectFolder.GetDetailsOf(ObjectFolderItem, 4) 'Date Created
  Cells(r, 5).Value = ObjectFolder.GetDetailsOf(ObjectFolderItem, 3) 'Date Modified
  Cells(r, 6).Value = ObjectFolder.GetDetailsOf(ObjectFolderItem, 20) 'Author
  Cells(r, 7).Value = ObjectFolder.GetDetailsOf(ObjectFolderItem, 1) 'Size
  r = r + 1
  X = SourceFolder.Path
Next FileItem

If IncludeSubfolders Then
  For Each SubFolder In SourceFolder.SubFolders
    ListFilesInFolder SubFolder.Path, True
  Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

End Sub