How to list all Path, Filenames & Filesizes

[JARHTMD]

I have some coding (from http://www.mrexcel.com/forum/excel-questions/471508-list-properties-all-files-folder.html ) to get filesize.

Public Function FileSize()
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
FileSize = FSO.FileSize("C:\Windows\Windows.exe")
End Function

I also have a macro (see below) which asks which folder & then puts the info (all folders & subfolders with dates) into Excel. I would like columns for FullPath; Filename; Filesize (maybe date-created & date-modified).
I really like the ability to specify the "top folder" when the macro is run. But I can't figure out how to modify to get what I want.

Sub FolderNames()
'Update 20141027
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
xRow = Range("A1").End(xlDown).Row + 1
Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name,
SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
getSubFolder subfld
Next subfld
End Sub

 

[Comfy]

You can adapt this to include recursion etc.

Sub List_Props()
    Dim i As Long
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir: Set oDir = oShell.Namespace("H:\Pics")


    For i = 0 To 40
        Debug.Print i, oDir.GetDetailsOf(oDir.Items, i)
    Next
End Sub
Sub Get_Properties()
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir: Set oDir = oShell.Namespace("P:\A Folder")
    Dim i As Long, j As Long
    Dim X As Variant


    i = 0
    For Each sFile In oDir.Items
            i = i + 1
            Cells(i, 1).Value = oDir.GetDetailsOf(sFile, 0)
    Next
    MsgBox "Done"
End Sub

The first Sub will provide you with the values to use with .GetDetailsOf

Run that first and then review the Immediate window for output.

FullPath = sFile.Path
FileName = oDir.GetDetailsOf(sFile, 0)
FileSize = oDir.GetDetailsOf(sFile, 1)

etc etc

 

[JARHTMD]

Thanks, so much, for your prompt reply.

I failed to mention that all the coding I showed was from online . . . written by others (not by me). I don't know how to program macros. I have (long ago) recorded some macros & then (in most cases) been able to figure out how to modify the generated code. Usually, it has been fairly clear what the code means & therefore I've been able to revise it (thru trial & error). This is too complicated for me. I don't know when/where/how to follow your instructions.

Sorry for my ignorance.

 

[Comfy]

Thanks, so much, for your prompt reply.

I failed to mention that all the coding I showed was from online . . . written by others (not by me). I don't know how to program macros. I have (long ago) recorded some macros & then (in most cases) been able to figure out how to modify the generated code. Usually, it has been fairly clear what the code means & therefore I've been able to revise it (thru trial & error). This is too complicated for me. I don't know when/where/how to follow your instructions.

Sorry for my ignorance.

No need to apologise

Give me a minute or two to write something.

 

[Comfy]

Give this a try:

Option Explicit
Dim fso As Object
Dim rng As Range
Sub ListAllFiles()
Dim fld As Object
Dim wb As Workbook
Dim ws As Worksheet


With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With


Dim xPath As String


With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With






On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
On Error GoTo 0
If xPath = "" Then MsgBox "No Folder was Selected.": Exit Sub
Set wb = ActiveWorkbook
On Error Resume Next
wb.Sheets("Output").Delete
On Error GoTo 0
Set ws = wb.Sheets.Add
ws.Name = "Output"


ws.Range("A1").Resize(1, 4).Value = Array("Path", "Name", "Date Created", "Date Last Modified")
Set rng = Range("A2").Resize(1, 4)






    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(xPath)


    RecursiveSearch fld
    
    Set fld = Nothing
    Set fso = Nothing
    
    With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With


MsgBox "Complete"
End Sub
Private Sub RecursiveSearch(fld As Object)
Dim fold As Object
Dim fil As Object


    For Each fold In fld.SubFolders
        RecursiveSearch fold
    Next
    
    Get_Properties (fld.Path)
End Sub
Sub Get_Properties(fString)
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir: Set oDir = oShell.Namespace(fString)


    For Each sFile In oDir.Items
        rng(1, 1).Value = sFile.Path
        rng(1, 2).Value = oDir.GetDetailsOf(sFile, 0)
        rng(1, 3).Value = oDir.GetDetailsOf(sFile, 4)
        rng(1, 4).Value = oDir.GetDetailsOf(sFile, 3)
        Set rng = rng.Offset(1)
    Next


End Sub

 

[JARHTMD]

That is almost exactly what I need . . . with one (tiny, I hope) change. Actually, you show what I asked for. I asked for the wrong thing. When I asked for "full path", that's not really what I meant. I'd like to exclude the filename from the path column. Include everything up to & including the rightmost backslash of the path. I'd also prefer that the name field be blank for "folder only rows", but that's not critical.

Oh! I just noticed . . . the filesize column is missing.

 

[Comfy]

That is almost exactly what I need . . . with one (tiny, I hope) change. Actually, you show what I asked for. I asked for the wrong thing. When I asked for "full path", that's not really what I meant. I'd like to exclude the filename from the path column. Include everything up to & including the rightmost backslash of the path. I'd also prefer that the name field be blank for "folder only rows", but that's not critical.

Oh! I just noticed . . . the filesize column is missing.

Here's a slight amendment.

Option Explicit
Dim fso As Object
Dim rng As Range
Sub ListAllFiles()
Dim fld As Object
Dim wb As Workbook
Dim ws As Worksheet




With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With




Dim xPath As String




With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With












On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
On Error GoTo 0
If xPath = "" Then MsgBox "No Folder was Selected.": Exit Sub
Set wb = ActiveWorkbook
On Error Resume Next
wb.Sheets("Output").Delete
On Error GoTo 0
Set ws = wb.Sheets.Add
ws.Name = "Output"




ws.Range("A1").Resize(1, 5).Value = Array("Path", "Name", "Size", "Date Created", "Date Last Modified")
Set rng = Range("A2").Resize(1, 5)












    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(xPath)




    RecursiveSearch fld
    
    Set fld = Nothing
    Set fso = Nothing
    
    With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With




MsgBox "Complete"
End Sub
Private Sub RecursiveSearch(fld As Object)
Dim fold As Object
Dim fil As Object




    For Each fold In fld.SubFolders
        RecursiveSearch fold
    Next
    
    Get_Properties (fld.Path)
End Sub
Sub Get_Properties(fString)
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir: Set oDir = oShell.Namespace(fString)




    For Each sFile In oDir.Items
        rng(1, 1).Value = Replace(sFile.Path, oDir.GetDetailsOf(sFile, 0), "")
        rng(1, 2).Value = oDir.GetDetailsOf(sFile, 0)
        rng(1, 3).Value = oDir.GetDetailsOf(sFile, 1)
        rng(1, 4).Value = oDir.GetDetailsOf(sFile, 4)
        rng(1, 5).Value = oDir.GetDetailsOf(sFile, 3)
        Set rng = rng.Offset(1)
    Next




End Sub

I'd also prefer that the name field be blank for "folder only rows"

There shouldn't be any folder only rows as this only outputs file details.

 

[JARHTMD]

= There shouldn't be any folder only rows as this only outputs file details.

It's not a problem. They may prove to be useful to me (or not - I'm not sure of all my future needs), but FYI SUBFOLDER-only rows are shown in the output. They are easier to find in a long list, if sorted. Interestingly, folder-only rows are ALWAYS at the bottom after sorting by size, whether high-to-low or low-to-high.

Thanks again for all the help you've provided. I really appreciate it.