Automatic Directory File List

[saleem77_pk]

Many thanks Gibbs for your macro file for Automatic Directory File List
, i found it was perfectly working in office 2003. could you please help me in modifying this macro, i want to add one more column in the start before file name that is folder in my index shown below

FolderFileSizeModified DateLast AccessedCreated DateFull Path

second as i have many winzip or winrr compress file so is it possible to add something in macro that treat these winzip/winrr file as directory/folder and extract the files from those compress folders

[Bob Phillips]

Post the code.

[Tinbendr]

Knowledge Base Entry (http://www.vbaexpress.com/kb/getarticle.php?kb_id=837), I suppose.

[Bob Phillips]

But that code already shows the parent folder.

[Bob Phillips]

Oops. The codes sent the headings twice, different ones!

Try this



Option Explicit

Sub PopulateDirectoryList()
'dimension variables
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet

ToggleStuff False 'turn of screenupdating

Set objFSO = New FileSystemObject 'set a new object in memory
strSourceFolder = BrowseForFolder 'call up the browse for folder routine
If strSourceFolder = "" Then Exit Sub

Workbooks.Add 'create a new workbook

Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1) 'set the worksheet
wsNew.Activate
'format a header
With wsNew.Range("A1:G1")
.Value = Array("Parent Folder", "File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With

With Application.FileSearch
.LookIn = strSourceFolder 'look in the folder browsed to
.FileType = msoFileTypeAllFiles 'get all files
.SearchSubFolders = True 'search sub directories
.Execute 'run the search

For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
i = x 'make the variable i = x
If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
i = x - 60000 'set i to the right number for row placement below
Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
With wsNew.Range("A1:F1")
.Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
"Last Accessed", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With

End If
On Error GoTo Skip 'in the event of a permissions error

Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
With wsNew.Cells(1, 1) 'populate the next row with the variable data
.Offset(i, 0) = objFile.Path
.Offset(i, 1) = objFile.Name
.Offset(i, 2) = Format(objFile.Size, "0,000") & " KB"
.Offset(i, 3) = objFile.DateLastModified
.Offset(i, 4) = objFile.DateLastAccessed
.Offset(i, 5) = objFile.DateCreated
.Offset(i, 6) = objFile.Path

End With
' Next objFile
Skip:
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
Next x
wsNew.Columns("A:F").AutoFit

End With

'clear the variables
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing

ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'''Code from kpuls, www.VBAExpress.com..portion (http://www.VBAExpress.com..portion) of Knowledge base submission
''www.codeguru.com

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing

Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function

Invalid:


ToggleStuff True
End Function

[jburbea]

i am new to the forum but would like to join since i am getting an error using the macro
i set reference to window script host object model when i execute the macro
populatedirectorylist through the button or directly i am getting the message:

run time error "445"
object does not support the action

debug shows me that the macro stopped at

with application.filesearch

what i should do to support that action?

thanks
:banghead:

[Bob Phillips]

If you are using Excel 2007, be aware that FileSearch is now deprecated.

[jburbea]

If you are using Excel 2007, be aware that ileSearch is now deprecated.
Xld,

thx

is there something else?

[Bob Phillips]

To search sub-directories you need to use FileSytemObject.

[GTO]

Edit...deleted. Just a sleepy/confused donkey.

[brettdj]

You could use my earlier KB article, http://www.vbaexpress.com/kb/getarticle.php?kb_id=405 which is recursive and adds further file properties.

It was built prior to xl2007, hence the 65536 row hardcoding.

Cheers

Dave

[Paul_Hossler]

... be aware that FileSearch is now deprecated


In a VBA-sense, what does deprecated mean and what is the overall effect(s)?

Paul

[Bob Phillips]

Actually, although everyone uses the term deprecated regarding FileSearch, it is the wrong term.

Deprecated means that the feature does not now (necessarly) work as in did in previous versions, but is retained in order to provide backward compatibility, allowing time to change the code before that feature is fially removed. So, with a deprecated feature, it won't not work, but it may not function as you expect.

It this case, FileSearch has been removed, pure and simple. Of course, it is arguable whether it is better to deprecate, which means the overall app won't break but fetaures may not work as intended, or remove, which means that those features break. It all depends upon your release testing I guess.

[Aussiebear]

Actually, although everyone uses the term deprecated regarding FileSearch,......

.......I do??????

(Sigh.... must be talking in my sleep again) :devil2:

[Bob Phillips]

.......I do??????

(Sigh.... must be talking in my sleep again) :devil2:

Yes, you, I heard you!

[grk1989]

I recently found this forum and the information on it has been tremedous help, but I was wondering how and if it would be possible to edit the script so that if I run the macro it creates a new worksheet in the current workbook.