Code deleted due to incorrect post...
see below...
Sub IndexFiles()
Sheets.Add
ActiveSheet.Name = "Index"
With Application.FileSearch
' If you leave the lookin line out it will display this
' list for the current active directory.
.LookIn = "c:my documents"
.FileType = msoFileTypeExcelWorkbooks
.Execute
End With
cnt = Application.FileSearch.FoundFiles.Count
For i = 1 To cnt
rng = "A" & i
Range(rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next
End SubSub IndexFiles()
Sheets.Add
ActiveSheet.Name = "Index"
With Application.FileSearch
' Change as applicable.
.LookIn = "C:MyDocuments"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
End With
cnt = Application.FileSearch.FoundFiles.Count
For i = 1 To cnt
rng = "A" & i
Range(rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next
End SubOption Explicit
Sub doADirectory(whatDir As String, OutputCell As Range)
Dim aFileName As String, FullName As String, i As Integer
ReDim FolderList(1 To 1) As String
aFileName = Dir(whatDir, &H1F)
'cheating a bit here; look up DIR in XL VBE help for 2nd argument
OutputCell.Value = whatDir
Set OutputCell = OutputCell.Offset(1, 1)
Do While aFileName <> ""
If aFileName = "." Or aFileName = ".." Then
Else
FullName = whatDir & aFileName
If (GetAttr(FullName) _
And vbDirectory) = vbDirectory Then
ReDim Preserve FolderList(LBound(FolderList) To UBound(FolderList) + 1)
FolderList(UBound(FolderList)) = aFileName
Else
OutputCell.Value = aFileName
Set OutputCell = OutputCell.Offset(1, 0)
End If
End If
aFileName = Dir
Loop
For i = LBound(FolderList) + 1 To UBound(FolderList)
doADirectory whatDir & FolderList(i) & Application.PathSeparator, OutputCell
Set OutputCell = OutputCell.Offset(0, -1)
Next i
End Sub
Sub startADir()
doADirectory "c:my documents", Range("a1")
End Sub
