create list of files from explorer 9

[smiley0q0]

I don't know if this is the right forum to post this question in, if not please let me know.

I have some folders that have 500-1000 files in each, I want to create a printable list of these files. is there a way to put a list like this in word or excel? Just the title of the files is all I need.

the only way i know of right know is an extremely time consuming long way... using explorer... F2,copy,ctl+tab over to excel,paste... then repeat... over and over and over and over...
just wondering if there is a faster more efficient way.

thanks,
Smiley

 

[mscallisto]

Might as well throw in two more cents.

This one lets you choose folders, include/exclude subfolders, pick cutoff date, see all the file attributes,all file dates etc., plus it doesn't blow up when trying to access some touchy folders like c:\System Volumn Information

To run it simply change the lines to read as you like:
ListFilesInFolder "C:\catalogs", "*.*", False 'List all files ,Excluding subfolders
ListFilesInFolder "C:\_TestFolder", ".xls", True 'List all excel ,Including subfolders
===========================================================



'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Set Global variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public switch As Boolean
Public r As Long
Public i As Integer
Public StartFolder, StartMask As String
Public DisplayFileName, DisplaySubFolder As String


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Error handling (an example)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub TestListFilesInFolder()
On Error GoTo MyProcedure_Error
GoTo MyProcedure_Exit
MyProcedure_Error:
If Err.Number = 70 Then
MsgBox ("Special handling for error #70" _
& Chr(13) & "DisplayFileName= " & DisplayFileName _
& Chr(13) & "DisplaySubFolder= " & DisplaySubFolder)
Resume Next
Else
MsgBox ("Special handling all other errors " _
& Chr(13) & "DisplayFileName= " & DisplayFileName _
& Chr(13) & "Sourse Folder= " & SourceFolder _
& Chr(13) & "DisplaySubFolder= " & DisplaySubFolder _
& Chr(13) & "Maybe Permissions error, can't proceed&quot
Resume Next
End If
MyProcedure_Exit:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Setup calling parameters
' Name, File Type, Include Subfolders (T/F)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
switch = True
i = 0 'count the files found

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ determining the next avail row (one space between folders)
'~ you can run this macro many times with different criteria
'~ and it will add to the existing spreadsheet or you can
'~ delete all the rows and start new (remember the 65,536 row limit!)
r = ActiveSheet.UsedRange.Rows.Count + 1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
ListFilesInFolder "C:\catalogs", "*.*", False 'List all files ,Excluding subfolders
ListFilesInFolder "C:\_TestFolder", ".xls", True 'List all excel ,Including subfolders
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Add Column Headers
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Range("A1:J1&quot
.Font.Bold = True
.Font.Italic = True
.Font.Size = 12
End With
'Range("A1:J1&quot.Font.Bold = True
Columns("E:E&quot.Select
Selection.NumberFormat = "#,##0"

Range("A1&quot.Formula = "File Name:"
Range("B1&quot.Formula = "Date Created:"
Range("C1&quot.Formula = "Date Last Accessed:"
Range("D1&quot.Formula = "Date Last Modified:"
Range("E1&quot.Formula = "File Size:"
Range("F1&quot.Formula = "File Type:"
Range("G1&quot.Formula = "Attributes:"
Range("H1&quot.Formula = "Short Path:"
Range("I1&quot.Formula = "Short Name:"
Range("J1&quot.Formula = "Path:"

Range("k1&quot.Formula = "0 Normal- No attributes are set"
Range("k2&quot.Formula = "1 ReadOnly- Attrib is read/write"
Range("k3&quot.Formula = "2 Hidden- Attrib is read/write"
Range("k4&quot.Formula = "4 System- Attrib is read/write"
Range("k5&quot.Formula = "8 Volume- Disk drive volume label. Attrib is read-only"
Range("k6&quot.Formula = "16 Directory- Folder or directory. Attrib is read-only"
Range("k7&quot.Formula = "32 Archive- File changed since last backup. Attrib is read/write"
Range("k8&quot.Formula = "64 Alias- Link or shortcut. Attrib is read-only"
Range("k9&quot.Formula = "128/2048 Compressed- Compressed file. Attribute is read-only"

With ActiveSheet.PageSetup
.LeftHeader = "Search Path [ " & StartFolder & "] Looking For [" & StartMask & "]""&""Comic Sans MS,Regular""&14"
.CenterHeader = ""
.RightHeader = ""
End With
Columns("A:J&quot.AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Application.StatusBar = False
ActiveWorkbook.Saved = True
ActiveWorkbook.Save
Range("A1&quot.Select
'Sort by first column
'Selection.Sort Key1:=Range("A2&quot, Order1:=xlAscending, Header:=xlYes, _
'OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

MsgBox ("Done&quot
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Main Subroutine
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub ListFilesInFolder(SourceFolderName As String, FileExtensions As String, IncludeSubfolders As Boolean)
Dim FSO
Dim SourceFolder, SubFolder
Dim FileItem
Dim Cutoff_Date As Date

Set FSO = CreateObject("Scripting.FileSystemObject&quot
Set SourceFolder = FSO.GetFolder(SourceFolderName)
Set ColRange = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
If switch = True Then
StartFolder = SourceFolderName
StartMask = FileExtensions
switch = False
End If
' Pick a cut-off date if you wish
Cutoff_Date = #1/31/2010#
For Each FileItem In SourceFolder.Files
DisplayFileName = FileItem.Name
Application.StatusBar = i & " Found so far " & DisplayFileName
If (StrComp(Right(UCase(FileItem), 4), UCase(FileExtensions), vbTextCompare) = 0) Or (StrComp(FileExtensions, "*.*", vbTextCompare) = 0) Then
If FileItem.DateLastAccessed < Cutoff_Date Then
i = i + 1 'number of files found
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.DateCreated
Cells(r, 3).Formula = FileItem.DateLastAccessed
Cells(r, 4).Formula = FileItem.DateLastModified
Cells(r, 5).Formula = FileItem.Size
Cells(r, 6).Formula = FileItem.Type
Cells(r, 7).Formula = FileItem.Attributes
On Error GoTo ShortName_Error
' save path and filename
' Cells(r, 8).Formula = FileItem.ShortPath

' save path only (maybe a problem here... check it out)
Cells(r, 8).Formula = Left(FileItem.ShortPath, Len(FileItem.ShortPath) - Len(Dir(FileItem.ShortPath)))
Cells(r, 9).Formula = FileItem.ShortName
GoTo Normal_behavior
ShortName_Error:
Cells(r, 8).Formula = "ShortPath is not Available"
Cells(r, 9).Formula = "ShortName is not Available"
Normal_behavior:
On Error GoTo 0
' save path and filename
Cells(r, 10).Formula = FileItem.Path

' save path only
Cells(r, 10).Formula = Left(FileItem.Path, Len(FileItem.Path) - Len(Dir(FileItem.Path)))
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Make "Bold" any filesizes larger than 1.0 gig or whatever
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If FileItem.Size > 1000000 Then
Cells(r, 5).Font.Bold = True
End If
r = r + 1 ' next row number
End If
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
DisplaySubFolder = SubFolder
If (SubFolder.Name <> "System Volume Information&quot Then
ListFilesInFolder SubFolder.Path, FileExtensions, True
End If
Next SubFolder
End If
End Sub

 

[dcompto]

My two cents...

In Outlook, on the Outlook Bar at left of screen:
Click the Other Shortcuts tab
Double-click My Computer
Browse to, and double-click, the desired folder
Ctrl-P to print
Make sure default Print style is Table Style

The only thing I don't like about the printout is that it does not show the name of the folder or its path.

 

[sawedoff]

Thanks, dcompto, your solution may be listed last, but I read through and tried all the rest, but for my users, yours is the easiest. Have a shiny thing. Thanks again.

Sawedoff