More Robust Directory List Generator?

[binar]

Fellow Forum Members,
Attached is a XLA file that generates a list of all filenames and associated subdirectories. It includes details such as NAME, DATE and SIZE. In addition, the filenames are hyperlinked to the actual file. In short, it's a very handy little tool that was created by someone who gave it away for free and who no longer supports this tool.

Is it possible to modify this XLA file so that it goes beyond just including NAME, DATE, and SIZE details? I would like it to include any of the details I have selected (checked off) inside the Windows7 Explorer "Choose Details" dialog window.

For example, I'm interested in generating a file list that includes the following details:
NAME, DATE, SIZE, LENGTH, 35mm FOCAL LENGTH, WIDTH

If this XLA tool can't be modified, is there a similar Excel 2007 add on tool that will support inclusion of the more exotic file details such as LENGTH and WIDTH in a list that is hyperlinked? Any help will be greatly appreciated

[shrivallabha]

Hi binar,

If you want to modify the code then you'll need password to open the VBA project as this add-in's VBA project is password protected.

On the other hand you will find some good coding samples on internet which use "FileSystemObject". You can start with any of them and work out a solution.

Like this page:http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder

[binar]

Hi binar,

If you want to modify the code then you'll need password to open the VBA project as this add-in's VBA project is password protected.

On the other hand you will find some good coding samples on internet which use "FileSystemObject". You can start with any of them and work out a solution.

Like this page:http://excelexperts.com/VBA-Tips-List-Files-In-A-Folder

Shrivallabha,
Thanks for your post. I would appreciate it a lot if you or any one else in this forum can help me in finding a solution for what I want to do.

I'm trying to create a list of video files and would like to add other file parameters available for choosing in the Windows7 Choose Detail dialog window. Below are three examples of some of the Parameters I was trying to plug into the VBA code shown below:

i.e.
myfile.Comments
myFile.width
myfile.Length (i.e. length of video)

Below is the code I'm trying to modify. I have tried adding columns with these examples, and the columns are just left blank.


Dim iRow
Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iRow = iRow + 1
Cells(iRow, iCol).Value = myFile.Length
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Width
iCol = iCol + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub



In the code above I added the LENGTH and WIDTH parameters and neither does not work. I'm also trying to get the File Name parameter to show as a hyperlink, also without success.

Attached as a zip file is the Excel file that was available for free download at Excelexperts (unlike the XLA file I uploaded in my first post, this file does not seem to be password protected). I would be very grateful if anyone out there could let me know what is the correct coding needed so that I could add additional parameters (i.e. LENGTH, WIDTH) in addition to PATH, NAME, DATE, and SIZE parameters. Any help will be greatly appreciated. Thanks.

[snb]

Have a look over here:

http://www.snb-vba.eu/VBA_Bestanden_en.html (http://www.snb-vba.eu/VBA_Bestanden_en.html)

[binar]

Have a look over here:

http://www.snb-vba.eu/VBA_Bestanden_en.html (http://www.snb-vba.eu/VBA_Bestanden_en.html)


SNB,
Thanks for the post. I looked over the webpage and I am not too sure what I should be looking at. Can you provide more specific information that could help me figure this out. Thank you very much.

[snb]

You can find code to retrieve music files properties
http://www.snb-vba.eu/VBA_Bestanden_en.html#L64 (http://www.snb-vba.eu/VBA_Bestanden_en.html#L64)

and
photofiles properties

[shrivallabha]

Shrivallabha,
Thanks for your post. I would appreciate it a lot if you or any one else in this forum can help me in finding a solution for what I want to do.
:
:
. Below are three examples of some of the Parameters I was trying to plug into the VBA code shown below:
i.e.
myfile.Comments
myFile.width
myfile.Length (i.e. length of video)

Below is the code I'm trying to modify. I have tried adding columns with these examples, and the columns are just left blank.
:
:
:
:
In the code above I added the LENGTH and WIDTH parameters and neither does not work. I'm also trying to get the File Name parameter to show as a hyperlink, also without success.

Hi Binar,

The list is coming blank as the properties or attributes are not applicable to the object you are using. So to know the properties and methods available you can use employ early binding.

1. In Visual Basic Editor window set reference to "Microsoft Scripting Runtime".
2. And Dim these variables specifically as below. This will prompt you with the methods and properties available for the Object.
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As FileSystemObject
Dim mySource As Folder
Dim myFile As File
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iRow = iRow + 1
Cells(iRow, iCol).Value = myFile.Length
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Width
iCol = iCol + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub


snb has provided you with snippets which you need to use in your code.

@snb: Superb work :jsmile:

[Tinbendr]

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As FileSystemObject
Dim mySource As Folder
Dim myFile As File
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Type

iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
These two counters were backwards, too.

[binar]

Thanks to all for there post. I have looked over everything and the reality is that the coding knowledge needed to make this work is something I don't have. I know I need to use one of the three DURATION related objects shown below:


With CreateObject("shell.application").namespace(***.Path & "\")
c370 = .getdetailsof(.Items.Item(***.Name), 21)
End With

With CreateObject("shell.application").namespace(***.Path & "\") c470 = split(.getdetailsof(.Items.Item(***.Name), -1),vblf)(3)
End With

With CreateObject("shell.application").namespace(***.Path & "\") c470a=mid(join(filter(split(.getdetailsof(.Items.Item(***.Name), -1),vblf),"Duration: "),""),11)
End With



My problem is I don't know how to integrate it with Tinbendr's code below:


Sub ListMyFiles(mySourcePath, IncludeSubfolders) Dim MyObject As FileSystemObject Dim mySource As Folder Dim myFile As File Set MyObject = New Scripting.FileSystemObject Set mySource = MyObject.GetFolder(mySourcePath) On Error Resume Next For Each myFile In mySource.Files iCol = 2 Cells(iRow, iCol).Value = myFile.Path iCol = iCol + 1 Cells(iRow, iCol).Value = myFile.Name iCol = iCol + 1 Cells(iRow, iCol).Value = myFile.Size iCol = iCol + 1 Cells(iRow, iCol).Value = myFile.DateLastModified iCol = iCol + 1 Cells(iRow, iCol).Value = myFile.Type iRow = iRow + 1 Next If IncludeSubfolders Then For Each mySubFolder In mySource.SubFolders Call ListMyFiles(mySubFolder.Path, True) Next End If End Sub


Any assistance in code integration will be tremendously appreciated. Thank you very much. :hi:

[Kenneth Hobs]

Binar, when you post code and it does not format properly, try pasting to an Excel range and then copy and paste that between VBA code tags.

I don't see a 35mm Focal Length in the snb's fine list. To test one that you know exists, replace the *** with your folder or folder+filename.ext.

Simply add one more iCol line to add the extra item(s). You will probably need an error catching routine as some of those properties may not exist for each file type.

If you want to use early binding and don't mind installing dsofile.dll, try Chip Pearson's routines. Of course these are advanced but are worth the effort sometimes. http://www.cpearson.com/excel/DocProp.aspx

If you ever get into vb.net and want another example using dsofile.dll, see my lesson here. http://www.wpuniverse.com/vb/showthread.php?25414-VB.NET-106-KeyMacros

[snb]

sub snb()
for each fl in createobject("scripting.filesystemobject").getfolder(Range("C7").value).files
With CreateObject("shell.application").namespace(Range("C7").value & "\")
msgbox = .getdetailsof(.Items.Item(dir(fl)), 21)
End With
next
End sub

[binar]

Binar, when you post code and it does not format properly, try pasting to an Excel range and then copy and paste that between VBA code tags.

I don't see a 35mm Focal Length in the snb's fine list. To test one that you know exists, replace the *** with your folder or folder+filename.ext.

Simply add one more iCol line to add the extra item(s). You will probably need an error catching routine as some of those properties may not exist for each file type.

If you want to use early binding and don't mind installing dsofile.dll, try Chip Pearson's routines. Of course these are advanced but are worth the effort sometimes. http://www.cpearson.com/excel/DocProp.aspx

If you ever get into vb.net and want another example using dsofile.dll, see my lesson here. http://www.wpuniverse.com/vb/showthread.php?25414-VB.NET-106-KeyMacros


Kenneth,
Thanks for your post. Let me give you an update.
First, I tested SNB's script below and got the following error:

COMPILE ERROR - Function call on left hand side of assignment must return variant or object



Sub snb()
For Each fl In createobject("scripting.filesystemobject").getfolder(Range("C7").value).files
With CreateObject("shell.application").namespace(Range("C7").value & "\")
msgbox = .getdetailsof(.Items.Item(dir(fl)), 21)
End With
Next
End Sub



It hangs up on the msgbox row.

Second, I put some effort at coding by following your instructions in your last post. Below for display for everyone to see is the way I understand it. I'm replacing all " *** " with " Range("C7").value & "\" " since this is the location on the spreadsheet where the path is inputted. Nevertheless, I tested it out and got an error.


Dim iRow
Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
With CreateObject("shell.application").namespace(Range("C7").value & "\")
c470a=mid(join(filter(split(.getdetailsof(.Items.Item(Range("C7").value & "\"), -1),vblf),"Duration: "),""),11)
End With

End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iRow = iRow + 1
Cells(iRow, iCol).Value = myFile.Length
iCol = iCol + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub



I would be tremendously appreciative if you can at your convenience or anyone else following this thread post some VBA code that accomplishes the following:

1. Generates a list that includes the follwing File Paremeters: NAME, SIZE, DATE, LENGTH (a.k.a. DURATION, however it displays as LENGTH in Windows7 Windows Explorer)

2. All the data in the NAME Parameter column is coded so that it appears HYPERLINKED so that when I click on the hyperlink it launches my Windows Media Player.

3. The icing in the cake would be if an easy way to add more File Parameters within the worksheet using drop down menus could be coded. So if in the future I would like to add the COMMENT Parameter, it could be done using a drop down menu from within the worksheet. Obviously, if this idea is too complex to code please disregard it.

Lastly, I took a look at using dsofile.dll and it seems to be an advanced level coding option that is not going to be a straight forward approach for a coding novice.

Again. any help that will let me solve this problem will be tremendously appreciated. Thanks. : pray2:

[Kenneth Hobs]

Obviously, you need to remove the "=" from your MsgBox line.

You can do all of that but do each part and then check.

When I get time, I will help you with more specific examples. Most of the work has already been done for you.

I know that an AVI file type has a duration. To test the duration, I am lazy and just poked the duration value into column A. Save a workbook and add:
Sub snb()
Dim fl As Variant
Dim i As Long
i = 2

Range("C7").Value2 = ThisWorkbook.Path
For Each fl In CreateObject("scripting.filesystemobject").getfolder(Range("C7").Value).Files
With CreateObject("shell.application").Namespace(Range("C7").Value & "\")
Range("A" & i).Value2 = .getdetailsof(.Items.Item(Dir(fl)), 21) 'Duration
End With
i = i + 1
Next
End Sub

[Kenneth Hobs]

I could not test this much on Vista since the Duration property values are not being shown for my avi and flv files.

Set the two references detailed in my comments.

Sub FileDetails()
Range("C7").Value2 = ThisWorkbook.Path

ListMyFiles Range("C7").Value2, 11
ActiveSheet.UsedRange.Columns.AutoFit
End Sub

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation
Sub ListMyFiles(mySourcePath As String, iRow As Long, _
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 iCol As Integer
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
iCol = 2
Cells(iRow, iCol).Value2 = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.DateLastModified
iCol = iCol + 1
Cells(iRow, iCol).Value2 = wShell.Namespace(myFile.Path).GetDetailsOf(myFile.Name, 21)
iCol = iCol + 1
'Range("A" & iRow).Hyperlinks.Add Range("A" & iRow), myFile.Path & "\" & myFile.Name, , , myFile.Name
Range("A" & iRow).Hyperlinks.Add Range("A" & iRow), myFile.Path & "\" & myFile.Name, , , myObject.GetBaseName(myFile.Name)
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
ListMyFiles mySubFolder.Path, iRow, True
Next
End If
End Sub

[binar]

Obviously, you need to remove the "=" from your MsgBox line.

You can do all of that but do each part and then check.

When I get time, I will help you with more specific examples. Most of the work has already been done for you.

I know that an AVI file type has a duration. To test the duration, I am lazy and just poked the duration value into column A. Save a workbook and add:
Sub snb()
Dim fl As Variant
Dim i As Long
i = 2

Range("C7").Value2 = ThisWorkbook.Path
For Each fl In CreateObject("scripting.filesystemobject").getfolder(Range("C7").Value).Files
With CreateObject("shell.application").Namespace(Range("C7").Value & "\")
Range("A" & i).Value2 = .getdetailsof(.Items.Item(Dir(fl)), 21) 'Duration
End With
i = i + 1
Next
End Sub


Kenneth,
Thanks for your post.

Just an update. I tested your code with my Excel 2007. I entered the path in Cell C7 and hit the LIST button and it didn't work. The only thing that happened was the path in Cell C7 changed to something else. Still trying to figure out what is happening. I'm going to try it again tomorrow where I work.

Moreover, I have posted 3 PNG files that show Detail Parameters I'm interested in and also show how they appear within my Windows7 Windows Explorer. One PNG is for Music, and the other PNG is for Video. The third PNG file shows the "Choose Details" dialog window. What is worth noting is how it offers both DURATION and LENGTH. I'm not sure what the difference is between the two but I picked both and what seems to work correctly is the LENGTH Detail Parameter. I'm pointing this out because I have noticed SNB's webpage shows code for DURATION but none for LENGTH. So I'm now wondering whether LENGTH is supported with any code.

As you can see from my screen captures there are a multitude of File Detail Parameters to pick from inside the "CHOOSE DETAILS" dialog window. I'm only interested in a few. Nevertheless, do you think Excel VBA coding is able to support any of the Detail Parameters listed within the "CHOOSE DETAILS" dialog window as long as they are checked off? Just curious to know. Any help you can provide will be greatly appreciated. Thanks. :hi:

http://img855.imageshack.us/img855/116/videodetailparameters.png


http://img36.imageshack.us/img36/3558/mp3detailparameters.png

http://img441.imageshack.us/img441/1097/choosedetailsdialogwind.png

[Kenneth Hobs]

Please only quote parts of posts if you need to point out some part. Otherwise just say something like, "in Kenneth's post #13, the file with the Duration values are PNG files typically though c:\windows\clock.avi has a duration value for those with Windows XP-".

There are 42 property details that you can get. I could post a routine that can put all into an array but if you only need a few, it should be easy to see how that is done by my code. Notice that you can put the name or word of the property detail and/or the value as well.

Obviously, when testing code, try to test in a blank sheet or even better yet, a blank workbook. Notice that I deleted the contents of the activesheet and put the saved workbook's path into cell C7.

Don't forget to set the two references.

Sub FileDetails()
ActiveSheet.UsedRange.Clear
Range("C7").Value2 = ThisWorkbook.Path

ListMyFiles Range("C7").Value2, 11
ActiveSheet.UsedRange.Columns.AutoFit
End Sub

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation
Sub ListMyFiles(mySourcePath As String, iRow As Long, _
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 iCol As Integer
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
iCol = 2
Cells(iRow, iCol).Value2 = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value2 = myFile.DateLastModified
Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
iCol = iCol + 1

With wShell.Namespace(mySource.Path)
Cells(iRow, iCol).Value2 = .GetDetailsOf(myFile.Name, 21) 'Duration word.
iCol = iCol + 1
Cells(iRow, iCol).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 21) 'Duration value.
End With

'Range("A" & iRow).Hyperlinks.Add Range("A" & iRow), myFile.Path , , , myFile.Name
Range("A" & iRow).Hyperlinks.Add Range("A" & iRow), myFile.Path , , , myObject.GetBaseName(myFile.Name)

iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
ListMyFiles mySubFolder.Path, iRow, True
Next
End If
End Sub

[binar]

Kenneth,
A million thanks for the code you are sharing in your #16 post. I tested out your code and I made sure to start with a clean worksheet as you instructed. In cell C7 I entered the PATH for the top level folder containing my music video collection. Then I hit the RUN button in the Macro Dialog window and I got the following error:

"Compile Error: User Defined type not defined"
(I have attached the XLSM file I am trying to make work)

The code stops working in area "C" indicated in the screen capture below. I tried tweaking the code to see if I could get it to work but I have to admit I still don't understand all of the levers and gears relating to your code. I have a general idea, but not enough to fix it on my own. Below I have posted a screen capture of your code highlighted with Letter Identifiers.

In addition, what I'm still trying to understand is what I need to do to your code so that I can make it fetch any of the other 42 property details you mentioned.

I am assuming the following:
"G" = fetches PATH data and places it in Column A
"H" = fetches NAME data and places it in Column B
"I" = fetches SIZE data and places it in Column C
"J" = fetches DATE LAST MODIFIED data and places it in Column D
"K" = fetches DATE as a number format and places it in Column E
"L" = Has me confused because my Windows Explorer shows it as LENGTH

Could I now correctly assume the following?
If I want to add FRAME WIDTH & FRAME HEIGHT I will need to add these new lines of code -


Cells(iRow, iCol).NumberFormat = "frame width"
iCol = iCol + 1

Cells(iRow, iCol).NumberFormat = "frame height"
iCol = iCol + 1


If you could clarify this for me I would appreciate it. Again, a million thanks for your generosity in developing a very cool File List Generator. I think it's going to be light years ahead of the List Generator I attached in my #1 Post. :hi:


http://img834.imageshack.us/img834/1484/codeforstudy.png

[Jan Karel Pieterse]

I think the answer is in post#14:

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

[Paul_Hossler]

There's a list of enumerates (sounds good :) )

Apparently, based on the post below, there is some OS changes

http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1


HTH

Paul

[shrivallabha]

I think the answer is in post#14:

' Tools > References > Microsoft Scripting Runtime
' Tools > References > Microsoft Shell Controls and Automation
Its there in #16 as well [his comments are in the code and last line reminds to set them].

[Kenneth Hobs]

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.
MsgBox "Hello World" 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:
x = 13 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.
?x

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.

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

[binar]

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

[Jan Karel Pieterse]

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".

[Kenneth Hobs]

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.

[Kenneth Hobs]

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_enable-script-host-windows-7.html

[binar]

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:


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.


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:

[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.

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

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

[Paul_Hossler]

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



;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

[binar]

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.

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

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:

[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]:
'----------------------------------------------------------------------------------------------------------------------
'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

Usage: Put Folder Path in cell A9 and Listing of subfolders (TRUE / FALSE) in B9.

[binar]

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]:
'----------------------------------------------------------------------------------------------------------------------
'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

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:


sRow.Offset(, 6).Value2 = .GetDetailsOf(.ParseName(myFile.Name), 27)


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:


It has a layout with New Folder Rows, also known as a Hierarchy Layout.
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.
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

[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.
'----------------------------------------------------------------------------------------------------------------------
'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

[snb]

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

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

[binar]

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.
'----------------------------------------------------------------------------------------------------------------------
'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



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/6826/projectfolder.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/1031/folder3rdlevel.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:

[shrivallabha]

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.

[snb]

While we can't control the Shell object behavior

I seriously doubt that:

Sub snb_fileseach_count()
sn = Filter(Split(Application.Trim(Replace(CreateObject("wscript.shell").exec("cmd /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

[shrivallabha]

I seriously doubt that:

Sub snb_fileseach_count()
sn = Filter(Split(Application.Trim(Replace(CreateObject("wscript.shell").exec("cmd /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
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.

[snb]

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

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