Sub TestListFilesInFolder_R1()
Dim dteLastRun As Date

Application.ScreenUpdating = False
With Sheet1
' .Cells.Clear
.Range("A3").Value = "Doc Number:"
.Range("B3").Value = "Direction:"
.Range("C1").Value = "Last Run Date: "
.Range("C1").HorizontalAlignment = xlHAlignRight
.Range("C3").Value = "File Type:"
.Range("D3").Value = "Date Created:"
.Range("E3").Value = "TO:"
.Range("F3").Value = "FROM:"
.Range("G3").Value = "Notes:"
.Range("H3").Value = "Short File Name:"
.Range("I3").Value = "Hyperlink:"
.Range("J3").Value = "Full Document Path:"
.Range("A3:J3").Font.Bold = True
If IsDate(.Range("D1").Value) Then
dteLastRun = .Range("D1").Value
Else
dteLastRun = Now() - 30
End If
.Range("D1").Value = VBA.Format(Now(), "mmm/dd/yyyy")
End With

With Sheet1.Range("A1")
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With

'list all files included subfolders
ListFilesInFolder "G:\Mining\Ventilation\16-Vent Upgrade 2010\", dteLastRun, True
Application.ScreenUpdating = True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, ByRef dteLast As Date, IncludeSubfolders As Boolean)
'lists information about the files in SourceFolder
'example: ListFilesInFolder "C:\FolderName\", True
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)

With Sheet1
r = .Range("J65536").End(xlUp).Row + 2
For Each FileItem In SourceFolder.Files
' display file properties
If FileItem.datecreated dteLast Then
.Cells(r, 3).Value = FileItem.Type
.Cells(r, 4).Value = FileItem.datecreated
.Cells(r, 8).Value = FileItem.Name
.Cells(r, 10).Value = FileItem.Path
.Cells(r, 9).Hyperlinks.Add Anchor:=.Cells(r, 9), _
Address:=.Cells(r, 10).Value, _
ScreenTip:="Click to open", _
TextToDisplay:=.Cells(r, 8).Value
r = r + 1 ' next row number
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, dteLast, True
Next SubFolder
End If
Columns("A:H").AutoFit
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
--
Jim Cone
Portland, Oregon USA
http://tinyurl.com/XLCompanion

..
..
..

"suej68"
wrote in message
...
On Jul 26, 9:07 am, "Jim Cone" wrote:
Remove or comment out this line: ".Cells.Clear"
That will prevent the clearing of the sheet.
Where is the "previous save date" found?
--
Jim Cone
Portland, Oregon USAhttp://tinyurl.com/ListFiles

.
.
.

Jim
the only save date that I have will be on the document properties.
unless you know of a way to tie it in to the code?
Sue