Can someone help me create a macro that lists excel files in a folder
and also gets the date the file was created and last modified?

I found this macro on the web, but it just gets the filenames:

Public Sub ListWorkbooks()
Dim Directory As String
Dim FileName As String
Dim IndexSheet As Worksheet
Dim rw As Long

'Change the directory below as needed
Directory = "R:\07\"
If Left(Directory, 1) < "\" Then
Directory = Directory & "\"
End If

rw = 1

Set IndexSheet = ThisWorkbook.ActiveSheet

FileName = Dir(Directory & "*.xls")
Do While FileName < ""
IndexSheet.Cells(rw, 1).Value = FileName
rw = rw + 1
FileName = Dir
Loop

Set IndexSheet = Nothing
End Sub

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

sFolder = "C:\test\"
ReDim arfiles(4, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(4, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(4, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
.Cells(i + 1, "C").Value = arfiles(2, i)
.Cells(i + 1, "D").Value = arfiles(3, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").AutoFit
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(4, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(4, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(4, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = oFile.DateCreated
arfiles(3, cnt) = oFile.DateLastModified
arfiles(4, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub


--
__________________________________
HTH

Bob

"ac1179" wrote in message
...
Can someone help me create a macro that lists excel files in a folder
and also gets the date the file was created and last modified?

I found this macro on the web, but it just gets the filenames:

Public Sub ListWorkbooks()
Dim Directory As String
Dim FileName As String
Dim IndexSheet As Worksheet
Dim rw As Long

'Change the directory below as needed
Directory = "R:\07\"
If Left(Directory, 1) < "\" Then
Directory = Directory & "\"
End If

rw = 1

Set IndexSheet = ThisWorkbook.ActiveSheet

FileName = Dir(Directory & "*.xls")
Do While FileName < ""
IndexSheet.Cells(rw, 1).Value = FileName
rw = rw + 1
FileName = Dir
Loop

Set IndexSheet = Nothing
End Sub

On Sep 30, 12:59*pm, "Bob Phillips" wrote:
Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

* * arfiles = Array()
* * cnt = -1
* * level = 1

* * sFolder = "C:\test\"
* * ReDim arfiles(4, 0)
* * If sFolder < "" Then
* * * * SelectFiles sFolder
* * * * Application.DisplayAlerts = False
* * * * On Error Resume Next
* * * * Worksheets("Files").Delete
* * * * On Error GoTo 0
* * * * Application.DisplayAlerts = True
* * * * Worksheets.Add.Name = "Files"
* * * * With ActiveSheet
* * * * * * For i = LBound(arfiles, 2) To UBound(arfiles, 2)
* * * * * * * * If arfiles(0, i) = "" Then
* * * * * * * * * * If fOutline Then
* * * * * * * * * * * * Rows(iStart + 1 & ":" & iEnd).Rows.Group
* * * * * * * * * * End If
* * * * * * * * * * With .Cells(i + 1, arfiles(4, i))
* * * * * * * * * * * * .Value = arfiles(1, i)
* * * * * * * * * * * * .Font.Bold = True
* * * * * * * * * * End With
* * * * * * * * * * iStart = i + 1
* * * * * * * * * * iEnd = iStart
* * * * * * * * * * fOutline = False
* * * * * * * * Else
* * * * * * * * * * .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(4, i)), _
* * * * * * * * * * * * * * * * * * Address:=arfiles(0, i), _
* * * * * * * * * * * * * * * * * * TextToDisplay:=arfiles(1, i)
* * * * * * * * * * .Cells(i + 1, "C").Value = arfiles(2, i)
* * * * * * * * * * .Cells(i + 1, "D").Value = arfiles(3, i)
* * * * * * * * * * iEnd = iEnd + 1
* * * * * * * * * * fOutline = True
* * * * * * * * End If
* * * * * * Next
* * * * * * .Columns("A:Z").AutoFit
* * * * End With
* * End If
* * 'just in case there is another set to group
* * If fOutline Then
* * * * Rows(iStart + 1 & ":" & iEnd).Rows.Group
* * End If

* * ActiveSheet.Outline.ShowLevels RowLevels:=1
* * ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

* * If FSO Is Nothing Then
* * * * Set FSO = CreateObject("Scripting.FileSystemObject")
* * End If

* * If sPath = "" Then
* * * * sPath = CurDir
* * End If

* * arPath = Split(sPath, "\")
* * cnt = cnt + 1
* * ReDim Preserve arfiles(4, cnt)
* * arfiles(0, cnt) = ""
* * arfiles(1, cnt) = arPath(level - 1)
* * arfiles(4, cnt) = level

* * Set oFolder = FSO.GetFolder(sPath)
* * Set oFiles = oFolder.Files
* * For Each oFile In oFiles
* * * * cnt = cnt + 1
* * * * ReDim Preserve arfiles(4, cnt)
* * * * arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
* * * * arfiles(1, cnt) = oFile.Name
* * * * arfiles(2, cnt) = oFile.DateCreated
* * * * arfiles(3, cnt) = oFile.DateLastModified
* * * * arfiles(4, cnt) = level + 1
* * Next oFile

* * level = level + 1
* * For Each oSubFolder In oFolder.Subfolders
* * * * SelectFiles oSubFolder.Path
* * Next
* * level = level - 1

End Sub

--
__________________________________
HTH

Bob

"ac1179" wrote in message

...



Can someone help me create a macro that lists excel files in a folder
and also gets the date the file was created and last modified?

I found this macro on the web, but it just gets the filenames:

Public Sub ListWorkbooks()
* Dim Directory As String
* Dim FileName As String
* Dim IndexSheet As Worksheet
* Dim rw As Long

* 'Change the directory below as needed
* Directory = "R:\07\"
* If Left(Directory, 1) < "\" Then
* * * Directory = Directory & "\"
* End If

* rw = 1

* Set IndexSheet = ThisWorkbook.ActiveSheet

* FileName = Dir(Directory & "*.xls")
* Do While FileName < ""
* * * IndexSheet.Cells(rw, 1).Value = FileName
* * * rw = rw + 1
* * * FileName = Dir
* Loop

* Set IndexSheet = Nothing
End Sub- Hide quoted text -

- Show quoted text -

Bob this is great. I tested your code and viewed the results. Is there
a way to remove the hyperlinks from the filenames? And can I also just
target the excel files in the specific folder "C:\test" and not files
in any subflolders. To be more specific I'd like to only loop through
excel files that begin with "D7"

Thanks so much for your help!