More Robust Directory List Generator?

Binar, if you spent as much time listening, i.e. reading and looking at what the code means as you do on your excellent work documenting your questions for help as in your last post, you would be the top coder on the forum. It is the old rule, measure twice, cut once.

Maybe you have never set a reference in the VBE, Visual Basic Editor? The normal practice to show menu navigation is to list the menu name or item to click or select and then use a demarcation symbol like ">" or "|". So, Tools > References > Microsoft Scripting Runtime > OK means to open VBE, Alt+F11. Select the Tools menu. Select the References... menu. Select the Microsoft Scripting Runtime list item. Click OK.

I usually make comments in my code to show others how to set a reference object. Reference objects will typically have methods and properties that are shown by intellisense if you Dim the object using early binding methods. Snb's code for example used late binding. There are advantages and disadvantages to both methods.

I notice that your first line of code was not "Option Explicit". To set the VBE to add it for you in new modules, Tools > Options > Require Variable Declaration > OK.

Once you set the objects as explained, running code is a quick way to see how it works if it is not obvious from code examination. You can use F8 in the VBE to step through code in debug mode to see what each part does.

The Immediate window in the VBE is a tool that I used for debugging or as a quick test of a code snippet. e.g.
[vba]MsgBox "Hello World"[/vba] After you press the Enter key on a line of code in the Immediate Window, that line will execute. Tips: Debug.print "whatever" in your code puts "whatever" into the Immediate window. Another trick that you can test global values. In the Immediate window:
[vba]x = 13[/vba] after pressing Enter key, if you then prefix the variable x with a question mark and press Enter key, you will see the value 13.
[vba]?x[/vba]

Had you used the Immediate window tips or ran the code once you fixed the references, you would see that the Numberformat lines that you posted would not do what you want. I used Numberformat to format the date.

Obviously, your "G" point item goes to column "B" rather than column "A" since iCol=2 in the line before it.

Since I don't have Win7, Paul's link was very helpful.

Your last post with the file changed some from what you posted earlier that required minor tweaks in my code. Since I was piddling with the code, I used range references rather than cells. With Range, intellisense works. It does not work with Cells.

I added my speedup module, set the references for you, and added a Duration and a Links column in the attachment. For those that don't like to open files, the code follows.

[vba]Sub FileDetails()
' http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn
ListMyFiles Range("C6").Value2, Range("A10"), Range("C7").Value
ActiveSheet.UsedRange.Columns.AutoFit
Range("C:C").HorizontalAlignment = xlCenter
Range("F:H").HorizontalAlignment = xlCenter
Range("A9").Activate
SpeedOff
End Sub

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation
Sub ListMyFiles(mySourcePath As String, sRow As Range, _
Optional IncludeSubfolders As Boolean = True)

Dim myObject As Scripting.FileSystemObject
Dim mySource As Scripting.Folder
Dim myFile As Scripting.File
Dim mySubFolder As Scripting.Folder
Dim wShell As Shell

Set wShell = New Shell
Set myObject = New Scripting.FileSystemObject
Set mySource = myObject.GetFolder(mySourcePath)

On Error Resume Next

For Each myFile In mySource.Files
With sRow
.Value2 = myFile.Path
.Offset(, 1).Value2 = myFile.Name
.Offset(, 2).Value2 = myFile.Size
.Offset(, 3).Value2 = myFile.Type
.Offset(, 4).Value2 = myFile.DateLastModified
.Offset(, 4).NumberFormat = "mm/dd/yyyy"
End With

With wShell.Namespace(mySource.Path)
'Cells(, 10).value2 = .GetDetailsOf(myFile.Name, 21) 'Duration word, XP. 36 in Vista and Win7.
sRow.Offset(, 5).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 151) 'Frame width Vista=265, Width=151 Win7.
sRow.Offset(, 6).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 153) 'Frame height Vista=263, Height=153 Win7.
sRow.Offset(, 7).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36) 'Duration value, XP=21. 36 in Vista and Win7.
'srow.offset(, 8).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36) 'Duration word, XP=21. 36 in Vista and Win7.
End With

' Hyperlink
'Srow.offset(,8).Hyperlinks.Add Srow.offset(,8), myFile.Path , , , myFile.Name
sRow.Offset(, 8).Hyperlinks.Add sRow.Offset(, 8), myFile.Path, , , myObject.GetBaseName(myFile.Name)

Set sRow = sRow.Offset(1)
Next

If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
ListMyFiles mySubFolder.Path, sRow, True
Next
End If
End Sub
[/vba]

Thanks to all for your postings.

Ok, it's obvious to me that the compile error I'm getting is probably relating to the comment below:

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation

I did not understand it nor was it clear in my head what Kenneth meant by "don't forget to setup the references". In addition, I wasn't aware the TOOLS menu resides in the MicroSoft Visual Basic app. I was looking for the TOOLS menu in the MicroSoft Excel Ribbon menu. That goes to show how clueless I am regarding VBA coding.

I have now managed to figure out I'm suppose to be in a dialog window named, "References - VBAProject" and apply a checkmark on some things known as References (which is all new to me).

Nevertheless, in this dialog window I'm able to find Microsoft Shell Controls and Automation but not Microsoft Scripting Runtime. The closest option I have is Microsoft Script Control 1.0. Is Microsoft Script Control 1.0 the same thing as Microsoft Scripting Runtime? Any help will be greatly appreciated. Thanks

No, it isn't the same beast. On my system, that library is immediately below the one you mention.
When you put a reference in a VBA project you are telling VBA that you want to include functions from a certain "library".

This can be anything that exposes functionality to VBA, including for example the Word application, which allows you to automate Word from Excel VBA.

You can also use third-party libraries and libraries that ship with Windows itself (the scripting runtime is one of those), as long as they expose their internals (objects, properties and methods) to the outside "world".

When you opened my workbook, did you see Missing for that reference in Tools > References?

It points to c:\windows\system32\scrrun.dll. You can browse to it and add it if needed.

References sometimes float to the top when you use them so it may not be in alphabetical order.

Is this a work computer running Win7 or personal? You might try checking to see if scripting is enabled. http://www.ehow.com/how_8392805_enab...windows-7.html

Kenneth,
Thanks for your posts numbered #21, #24 and #25.

And Jan, Thanks for your post numbered #23.

Kenneth regarding posts numbered #24 and #25. At my place of employment I was not able to find the Microsoft Scripting Runtime Reference. However, when I tried it out on my home PC I had no problem finding and activating the two References listed below:
1. Microsoft Scripting Runtime
2. Microsoft Shell Controls and Automation

Now regarding your post numbered #21. I have tested out your attached file and it works with no compile errors. It generated me a list of 3,000 MP3 files without a hickup. After that test I guess you can rest assured that your code is solidly built.

Outside of my 3,000 MP3 file test I spent some time trying to figure out why your script is not picking up the DURATION parameters for my videos and music files. My hunch is that it has to do something with a conflict between LENGTH vs. DURATION. My Windows7 Explorer shows LENGTH. The DURATION parameter does not seem to be active. I also spent some time trying to figure out why the FRAME HEIGHT, FRAME WIDTH and BIT RATE parameters are not being pulled into the list.

The tweaking I did in an effort to get missing parameters to become active involved uncommenting the top and bottom lines of code shown below:

[vba]
Cells(, 10).Value2 = .GetDetailsOf(myFile.Name, 21) 'Duration word, XP. 36 in Vista and
Win7.

sRow.Offset(, 5).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 151) 'Frame
width Vista=265, Width=151
Win7.

sRow.Offset(, 6).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 153) 'Frame
height Vista=263, Height=153
Win7.

sRow.Offset(, 7).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36)
'Duration value, XP=21. 36 in Vista and
Win7.

sRow.Offset(, 8).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 36) 'Duration
word, XP=21. 36 in Vista and Win7.
[/vba]

I tried various tweaks on this area of the code and none seem to fix the problem.

Any tips you can provide at your convenience on what I need to do to make the script pull in the LENGTH, FRAME WIDTH, FRAME HEIGHT, and BIT RATE parameter data will be much appreciated. Attached is a worksheet I did for both Videos and Audio files that show the empty parameters I mentioned along with some notes in two different worksheet tabs.

Lastly, the Hyperlink column is very cool. It is awesome how just clicking on the hyperlink invokes the Windows Media Player and plays the selected video.

Once again Kenneth, thanks for your help with this project. It is tremendously appreciated. :hi:

Obviously, you would need to use 27 to get the Length rather than 21 for Duration.

Of course this method would get the Length value as well.

[vba] With CreateObject("shell.application").Namespace("c:\myfiles\excel\fso")
MsgBox Mid(Join(Filter(Split(.GetDetailsOf(.Items.Item("BIT_INTEL_INDEO.AVI"), -1), vbLf), "Length: "), ""), 9)
End With[/vba]

If you use virtual drives, these sorts of functions will not work properly.

On of the things I learned from the link in #19 was that .GetDetailsOf is O/S dependent, both name and number. So if you're planning to make this portable, then you'll need to adjust for the OS

Quote:

---

;Comments:
; Please notice that attributes are specific to the OS. This means that not only can the
; Attribute number be different from one OS to the next, but the Attribute Name can be
; different as well. As in the examples above, in Windows XP, the duration of the song was
; called "Duration, but in Vista it's called "Length". Thanks MS.

---

Paul

Quote:

---

Originally Posted by Kenneth Hobs

Obviously, you would need to use 27 to get the Length rather than 21 for Duration.

Of course this method would get the Length value as well.

[vba] With CreateObject("shell.application").Namespace("c:\myfiles\excel\fso")
MsgBox Mid(Join(Filter(Split(.GetDetailsOf(.Items.Item("BIT_INTEL_INDEO.AVI"), -1), vbLf), "Length: "), ""), 9)
End With[/vba]

If you use virtual drives, these sorts of functions will not work properly.

---

Kenneth,
A million thanks for your last post. Me bowing down in reverence to your VBA coding talent: :bow:

Your post # 27 enabled me to figure out what tweaks to make to your code so I could grab the file attributes I want. In the spirit of sharing the VBA knowledge I have learned from this thread, I’m posting 30 of the 266 Windows7 file attributes from the link provided in Post #19 by Paul. I know now that the number values shown below are a big part of the magic that enables your VBA code to fetch the correct file attribute. In short, I’m now able to successfully grab the LENGTH and BIT RATE file attributes since I now understand the role the numbers below play in your code.

;Windows 7
;------------------------------------------------
; 0 Name
; 1 Size
; 2 Item type
; 3 Date modified
; 4 Date created
; 5 Date accessed
; 6 Attributes
; 7 Offline status
; 8 Offline availability
; 10 Owner
; 11 Kind
; 12 Date taken
; 13 Contributing artists
; 14 Album
; 15 Year
; 16 Genre
; 17 Conductors
; 18 Tags
; 19 Rating
; 20 Authors
; 21 Title
; 22 Subject
; 23 Categories
; 24 Comments
; 25 Copyright
; 26 #
; 27 Length
; 28 Bit rate
; 29 Protected
; 30 Camera model


CONCLUDING PHASE
Kenneth I have a concluding phase to this project I would like to enquire about from you or anyone out there willing to contribute some more VBA knowledge (at their convenience). Below is a screen capture of the results the XLA file from my Post #1 generates (which is a locked file). How much change to your code is required so that it can perform the four tasks shown below?


http://img37.imageshack.us/img37/6963/oldxlsfile.png

In short, how can your code be made to combine the PATH and FILE NAME data together so that the hierarchy layout shown above is generated after I hit RUN Macro?
This hierarchy level is very useful when viewing a list that contains thousands of records. In addition, one more thing that is also very useful is the Folder Sum Value which provides a file size summation value of all the files contained within a folder. The gray colored rows also makes it easier identify where a folder begins and what subordinate files in contains.

In closing, I think it would be a great learning experience if I could compare the VBA code that generates a list similar to what is shown in the screen capture above to the VBA you posted in Post # 21.

I would be tremendously appreciative if you or anyone in this forum could provide any VBA knowledge in making the last modifications to your code in Post #21. Thanks again for you help. :hi:

Hi,

I had little time on my hands today (and some on yesterday) so I was playing a bit with Shell object. What I found was Shell object can be employed for listing files and folders just like FileSystemObject. It seems to be on the faster side.

I have put together a code which does similar kind of listing but the formatting is little different. Also there are few more columns which aren't there in my macro but I guess you can add them [using Paul's list :)].

The code is as below [See attachment]:
[vba]'----------------------------------------------------------------------------------------------------------------------
'If you are copying and changing this code then do not forget to add:
'Tools | References | Microsoft Shell Controls and Automation
'----------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes
Public objShApp As Shell
Public i As Long
Public Sub RunFileFolderList()
Dim strPath As String

'----------------------------------------------------------------------------------------------------------------------
'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings
'----------------------------------------------------------------------------------------------------------------------
i = 11
If Range("A" & Rows.Count).End(xlUp).Row > i Then Range("A11:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents

With Application
.ScreenUpdating = False

ListItemsInFolder Range("A9").Value, Range("B9").Value

.ScreenUpdating = True
End With

Set objShApp = Nothing

End Sub
Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean)
Dim fldItem As FolderItem

If objShApp Is Nothing Then Set objShApp = New Shell

'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objShApp.Namespace(strPath)
For Each fldItem In .Items

'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
If InStr(fldItem.Parent, ".zip") = 0 Then
If fldItem.IsFolder Then
Cells(i, 1).Value = fldItem.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
End If
If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder
End If
Next fldItem
End With

End Sub
[/vba]
Usage: Put Folder Path in cell A9 and Listing of subfolders (TRUE / FALSE) in B9.

Quote:

---

Originally Posted by shrivallabha

Hi,

I had little time on my hands today (and some on yesterday) so I was playing a bit with Shell object. What I found was Shell object can be employed for listing files and folders just like FileSystemObject. It seems to be on the faster side.

I have put together a code which does similar kind of listing but the formatting is little different. Also there are few more columns which aren't there in my macro but I guess you can add them [using Paul's list :)].

The code is as below [See attachment]:
[vba]'----------------------------------------------------------------------------------------------------------------------
'If you are copying and changing this code then do not forget to add:
'Tools | References | Microsoft Shell Controls and Automation
'----------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes
Public objShApp As Shell
Public i As Long
Public Sub RunFileFolderList()
Dim strPath As String

'----------------------------------------------------------------------------------------------------------------------
'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings
'----------------------------------------------------------------------------------------------------------------------
i = 11
If Range("A" & Rows.Count).End(xlUp).Row > i Then Range("A11:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents

With Application
.ScreenUpdating = False

ListItemsInFolder Range("A9").Value, Range("B9").Value

.ScreenUpdating = True
End With

Set objShApp = Nothing

End Sub
Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean)
Dim fldItem As FolderItem

If objShApp Is Nothing Then Set objShApp = New Shell

'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objShApp.Namespace(strPath)
For Each fldItem In .Items

'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
If InStr(fldItem.Parent, ".zip") = 0 Then
If fldItem.IsFolder Then
Cells(i, 1).Value = fldItem.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
i = i + 1
End If
If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder
End If
Next fldItem
End With

End Sub
[/vba]
Usage: Put Folder Path in cell A9 and Listing of subfolders (TRUE / FALSE) in B9.

---

Shrivallabha,
A million thanks for your post #30. I can not thank you enough for sharing the code you posted. I have tested it out on a single root folder containing many nested folders which in turn contain several thousand files and it works without a problem. I am amazed with the speed. It's very fast.

I now have some questions regarding your code. I want to add the capability for it to fetch BIT RATE and LENGTH file attributes for Columns E & F. In comparing your code to Kenneth's in Post #21 I noticed your code does not use code similar to what is shown below:

[vba]
sRow.Offset(, 6).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 27)
[/vba]

Where in your code do I insert the line of code above so in can be able to fetch LENGTH data? (LENGTH = "27") Is this difference because you are using SHELL Object?

In addition, the screen capture below shows something I like about your layout. Every cell shown in GREEN seems to be part of what I identify as a "New Folder Row". These New Folder Rows are very helpful when looking through a list with thousands of files. They enable one to identify nested folders more easier. In my post #29 the screen capture shows the NEW FODLER ROWS hightlighted as GRAY. How can your code be modified so that the New Folder Row is also highlighted in Gray?

Also you will notice in my screen capture below that the GREEN cells show FILE COUNT and FILE SIZE values in the New Folder Row. What kind of code can be added to your code to enable it to display FILE COUNT and FILE SIZE values?

If you or anyone out there following this thread could address my three questions, I would be very grateful.

My interest is to have a File Attribute List Generator with the following features:

1. It has a layout with New Folder Rows, also known as a Hierarchy Layout.
2. It provides FILE COUNT and FILE SIZE values for each nested folder and for the ROOT folder it provides total Folder Count, File Count and Size in Megabytes.
3. I need the code to be easy to modify when it relates to adding the capability to fetch additional File Attributes such as BIT RATE and LENGTH.

If anyone out there could post a script that can meet these three objectives, it is then my opinion the resulting XLSM file will be the best code ever posted in this forum. :hi:

http://img62.imageshack.us/img62/1407/visionb.png

Hi Binar,

I found some time today evening. I spent some time digging around Shell object's size property but it fails to return any info for Folder objects so it was of no use. Ultimately I have used FSO for that bit only. Along with FSO, formatting has added some overhead. Which means the code will be on the slower side.

Replace the previous code with this one.
[VBA]'----------------------------------------------------------------------------------------------------------------------
'If you are copying and changing this code then do not forget to add:
'Tools | References | Microsoft Shell Controls and Automation
'----------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes
Public objShApp As Shell
Public i As Long
Public Sub RunFileFolderList()
Dim strPath As String

'----------------------------------------------------------------------------------------------------------------------
'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings
'----------------------------------------------------------------------------------------------------------------------
i = 11
If Range("A" & Rows.Count).End(xlUp).Row > i Then
Range("A11:A" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Delete
End If

With Application
.ScreenUpdating = False

ListItemsInFolder Range("A9").Value, Range("B9").Value

.ScreenUpdating = True
End With

GetSizeAndFileInfo

Set objShApp = Nothing

End Sub
Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean)
Dim fldItem As ShellFolderItem

If objShApp Is Nothing Then Set objShApp = New Shell

'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objShApp.Namespace(strPath)
For Each fldItem In .Items

'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
If InStr(fldItem.Parent, ".zip") = 0 Then
If fldItem.IsFolder Then
Cells(i, 1).Value = fldItem.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
Cells(i, 1).Resize(, 5).Interior.ColorIndex = 48
i = i + 1
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
'---------------------------------------------------------------------------------------------------------
'Binar, add columns here like I have demonstrated below
'---------------------------------------------------------------------------------------------------------
Cells(i, 5).Value = .GetDetailsOf(.ParseName(fldItem.Name), 27)
i = i + 1
End If
If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder
End If
Next fldItem
End With

End Sub
Private Sub GetSizeAndFileInfo()
Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 11 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, 2).Value) = 0 Then
Cells(i, 4).Value = objFSO.GetFolder(Cells(i, 1).Value).Files.Count & " Files, " & _
Round(objFSO.GetFolder(Cells(i, 1).Value).Size / 1024 / 1024, 2) & " MB"
End If
Next i

Set objFSO = Nothing

End Sub
[/VBA]

If you want to learn more about which properties to read:

[VBA]Sub snb()
ReDim sn(64, 1)

With New Shell
For j = 1 To 64
sn(j, 0) = .Namespace("G:\OF").GetDetailsOf("", j)
Next
End With

Cells(1).Resize(UBound(sn) + 1) = sn
End Sub[/VBA]

Quote:

---

Originally Posted by shrivallabha

Hi Binar,

I found some time today evening. I spent some time digging around Shell object's size property but it fails to return any info for Folder objects so it was of no use. Ultimately I have used FSO for that bit only. Along with FSO, formatting has added some overhead. Which means the code will be on the slower side.

Replace the previous code with this one.
[vba]'----------------------------------------------------------------------------------------------------------------------
'If you are copying and changing this code then do not forget to add:
'Tools | References | Microsoft Shell Controls and Automation
'----------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Compare Text 'We might come across mixtures of uppercase lowercase letters sometimes
Public objShApp As Shell
Public i As Long
Public Sub RunFileFolderList()
Dim strPath As String

'----------------------------------------------------------------------------------------------------------------------
'Setting the worksheet to list results from row 11 and performing cleanup to remove previous listings
'----------------------------------------------------------------------------------------------------------------------
i = 11
If Range("A" & Rows.Count).End(xlUp).Row > i Then
Range("A11:A" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Delete
End If

With Application
.ScreenUpdating = False

ListItemsInFolder Range("A9").Value, Range("B9").Value

.ScreenUpdating = True
End With

GetSizeAndFileInfo

Set objShApp = Nothing

End Sub
Public Sub ListItemsInFolder(strPath As String, boolSubFolder As Boolean)
Dim fldItem As ShellFolderItem

If objShApp Is Nothing Then Set objShApp = New Shell

'----------------------------------------------------------------------------------------------------------------------
'Shell's Namespace object holds onto many different and useful properties that can used to extract information
'In this code we have used its FileSystemObject equivalents
'----------------------------------------------------------------------------------------------------------------------
With objShApp.Namespace(strPath)
For Each fldItem In .Items

'----------------------------------------------------------------------------------------------------------------------
'The code tends to error when it comes across a zip file which in turn may contain a folder. The code then gives you
'an RTE so to bypass this possibility we use following check of verifying .zip
'----------------------------------------------------------------------------------------------------------------------
If InStr(fldItem.Parent, ".zip") = 0 Then
If fldItem.IsFolder Then
Cells(i, 1).Value = fldItem.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
Cells(i, 1).Resize(, 5).Interior.ColorIndex = 48
i = i + 1
Else
Cells(i, 1).Value = Left(fldItem.Path, InStrRev(fldItem.Path, fldItem.Name) - 2)
Cells(i, 2).Value = fldItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=fldItem.Path, TextToDisplay:="Click Here"
'---------------------------------------------------------------------------------------------------------
'Binar, add columns here like I have demonstrated below
'---------------------------------------------------------------------------------------------------------
Cells(i, 5).Value = .GetDetailsOf(.ParseName(fldItem.Name), 27)
i = i + 1
End If
If fldItem.IsFolder And boolSubFolder Then ListItemsInFolder fldItem.Path, boolSubFolder
End If
Next fldItem
End With

End Sub
Private Sub GetSizeAndFileInfo()
Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

For i = 11 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, 2).Value) = 0 Then
Cells(i, 4).Value = objFSO.GetFolder(Cells(i, 1).Value).Files.Count & " Files, " & _
Round(objFSO.GetFolder(Cells(i, 1).Value).Size / 1024 / 1024, 2) & " MB"
End If
Next i

Set objFSO = Nothing

End Sub
[/vba]

---

Shrivallabha,
A million thanks for your post #32. I did some preliminary testing on it and it works great. No Runtime errors that I can report to you. You have created what is in my opinion the most useful and the most beautiful piece of code posted in this forum. This is me bowing down to you in reverence to your coding talent: :bow:

Below is a sceen capture of the list your code generated on my PC.

http://img821.imageshack.us/img821/387/resultq.png

Thanks for including the GRAY colored rows and files/size counter values. I think
these two features are very cool.

You may have noticed in the screen capture above that I have colored 4 Rows in GREEN. I have done this so I can ask you why you think your code is taking the files inside the ROOT folder and spreading them in several levels? My opinion is all the files inside C:\ROOT\Stuff should be grouped together and not separate as they are shown in GREEN. Can you clarify why you think the Folder levels for C:\ROOT\Stuff is spread across various locations in the list?

I am posting screen captures of all my Windows 7 folder levels to help you compare the levels of your list to the folder levels as they appear in my Windows7 OS.

C:\ROOT\Stuff =
http://img513.imageshack.us/img513/6997/rootn.png


C:\ROOT\Stuff\Excel Lister Project =

http://img204.imageshack.us/img204/6...jectfolder.png


C:\ROOT\Stuff\Excel Lister Project\Kenneth's Latest =
http://img827.imageshack.us/img827/7349/folder2w.png


C:\ROOT\Stuff\Excel Lister Project\Kenneth's Latest\My Testing file =

http://img534.imageshack.us/img534/1...er3rdlevel.png


C:\ROOT\Stuff\Excel Lister Project\WWW Links =

http://img99.imageshack.us/img99/1939/wwwu.png


C:\ROOT\Stuff\Graphics =

http://img406.imageshack.us/img406/9121/graphicsf.png


C:\ROOT\Stuff\NPR Podcasts =

http://img831.imageshack.us/img831/5448/npr.png



I am now going to spend some time playing around with adding more column attributes to your code, for example: BIT RATE. Worth noting: I have noticed that your code did include the MP3 file LENGTH attribute which is great. Thanks SNB for your tip.

Once again, a million thanks for sharing your code. I look forward to using it a lot once I study it some more. :hi:

Hi Binar,

Thank you for the feedback. The behavior can be attributed to the way the code works or loops through the folder list.

Maybe a small example shall clarify it. Suppose we are listing following folder.

C:\Data
which has in turn following items as below:
C:\Data\MyFolder
C:\Data\Mylist.xlsx
And then in C:\Data\MyFolder
C:\Data\MyFolder\Test.xlsx
C:\Data\MyFolder\Some.xlsx

The code loops through as it comes across each folder item so supposing that it first meets C:\Data\MyFolder then it loops through all items in the subfolder before returning to the main folder.

C:\Data
C:\Data\MyFolder
C:\Data\MyFolder\Test.xlsx
C:\Data\MyFolder\Some.xlsx
C:\Data\Mylist.xlsx

VBA just remains 'mindful' of all items it is looping through. So all in all the structure will appear akin to the 'Tree' that we see in Windows Explorer. I hope this clarifies your query.

While we can't control the Shell object behavior, a sort can be applied at the end of the code based on Col A and Col B. If you want it then I want you to work on it which I am sure will give you immense satisfaction.

Quote:

---

While we can't control the Shell object behavior

---

I seriously doubt that:

[vba]Sub snb_fileseach_count()
sn = Filter(Split(Application.Trim(Replace(CreateObject("wscript.shell").exec("c md /c dir G:\OF\*.txt /s").StdOut.readall, vbLf & " Map", vbCrLf & ".txtMap")), vbCrLf), ".txt")

ReDim sp(UBound(sn), 3)
For j = 0 To UBound(sn)
If Left(sn(j), 8) = ".txtMap " Then
c00 = Right(Split(sn(j), ":\")(0), 1) & ":\" & Split(sn(j), ":\")(1)
Else
sp(j, 0) = c00
sq = Split(sn(j))
sp(j, 1) = Left(sn(j), 16)
sp(j, 2) = sq(2)
sp(j, 3) = Trim(Split(Mid(sn(j), 17), sq(2))(1))
End If
Next

Cells(1).Resize(UBound(sp) + 1, 4) = sp
Columns(1).SpecialCells(4).EntireRow.Delete
End Sub[/vba]

Quote:

---

Originally Posted by snb

I seriously doubt that:

[vba]Sub snb_fileseach_count()
sn = Filter(Split(Application.Trim(Replace(CreateObject("wscript.shell").exec("c md /c dir G:\OF\*.txt /s").StdOut.readall, vbLf & " Map", vbCrLf & ".txtMap")), vbCrLf), ".txt")

ReDim sp(UBound(sn), 3)
For j = 0 To UBound(sn)
If Left(sn(j), 8) = ".txtMap " Then
c00 = Right(Split(sn(j), ":\")(0), 1) & ":\" & Split(sn(j), ":\")(1)
Else
sp(j, 0) = c00
sq = Split(sn(j))
sp(j, 1) = Left(sn(j), 16)
sp(j, 2) = sq(2)
sp(j, 3) = Trim(Split(Mid(sn(j), 17), sq(2))(1))
End If
Next

Cells(1).Resize(UBound(sp) + 1, 4) = sp
Columns(1).SpecialCells(4).EntireRow.Delete
End Sub[/vba]

---

What I meant, if you read carefully enough, then it is the output which can be sorted and NOT the way Shell object itself outputs its result.

there's a sorting option in shell.exec:
e.g sorting on date: /o-d
sorting on size /o-s

[VBA]sn = Filter(Split(Application.Trim(Replace(CreateObject("wscript.shell").exec("c md /c dir G:\OF\*.txt /s /o-d").StdOut.readall, vbLf & " Map", vbCrLf & ".txtMap")), vbCrLf), ".txt")[/VBA]