Solved: List directory contents based on cell value

[khaledocom]

Hi gentlemen,

In the attached file I need the code to do listing task based on text in cell A1
Do not display the browser dialog box.

Thanks in advance.

[Kenneth Hobs]

Just replace the 3rd line from the end of the Sub as shown.

Sub CreateList()
Application.ScreenUpdating = False
Worksheets.Add ' create a new workbook for the folder list
' add headers
With Cells(1, 1)
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Cells(3, 1).Value = "Folder Path:"
Cells(3, 2).Value = "Folder Name:"
Cells(3, 3).Value = "Size:"
Cells(3, 4).Value = "Subfolders:"
Cells(3, 5).Value = "Files:"
Cells(3, 6).Value = "Short Name:"
Cells(3, 7).Value = "Short Path:"
Range("A3:G3").Font.Bold = True
'ListFolders BrowseFolder, True
ListFolders Worksheets("Sheet1").Range("A1").Value2, True
Application.ScreenUpdating = True
End Sub

[khaledocom]

Thanks a lot Ken,
It's really perfect.

[khaledocom]

Dear Ken,
Is it possible to make the same code (by some adjustments) extracts all files in a directory.
Now, it only shows sub folders.
Thanks in advance.

[Kenneth Hobs]

Sub TestListFilesInFolder()
'With Range("A1")
' .Formula = "Folder contents:"
' .Font.Bold = True
' .Font.Size = 12
'End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "Attributes:"
Range("H3").Formula = "Short File Name:"
Range("A3:H3").Font.Bold = True
'ListFilesInFolder "c:\Windows\System32", True
ListFilesInFolder Worksheets("Sheet1").Range("A1").Value2, True
' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True

'Note: FSO Requires Tools > References > (Microsoft Scripting Runtime) c:\windows\system32\scrrun.dll
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Path & FileItem.Name
Cells(r, 2).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub

[khaledocom]

Perfect, Thanks again boss.

[Kenneth Hobs]

Glad it helped.

That is old code. I usually comment where I got it from. For 2007+, you should change:
r = Range("A65536").End(xlUp).Row + 1
to:
r = Range("A" & rows.count).End(xlUp).Row + 1

[khaledocom]

Ken, you mean VBA codes for 2003 doesn't work under 2007?!
Please advise because our company will move to windows 7 and office 2010.
and all my vba codes are under ver. 2003. I'm lost then!!!!!

[Kenneth Hobs]

For the most part, they will work. The reason that I amended the code line was because Excel 2007+ lets you have more rows than 2003.

The biggest problem when making the transition is when older code uses FileSearch(). For some odd reason, Microsoft did not include it in 2007+. I have posted a class that gives you similar features but fso methods usually meets most peoples needs.

[khaledocom]

Thanks a lot Ken for your valuable help and advice.

[Kiran Nikam]

Hi, Can you please tell me how to start the new thread