You might want to try this macro. It opens a file browser and copies the
selected file names to the active cell.

Dim vrtNames As Variant
Dim vrtNames2() As Variant
Dim vrtParsedName As Variant
Dim i As Long

vrtNames = Application.GetOpenFilename(, , , , True)
If VarType(vrtNames) And vbArray Then
ReDim vrtNames2(1 To UBound(vrtNames), 1 To 1)
For i = 1 To UBound(vrtNames)
vrtParsedName = Split(Expression:=vrtNames(i), Delimiter:="\")
vrtNames2(i, 1) = vrtParsedName(UBound(vrtParsedName))
Next i
ActiveCell.Resize(UBound(vrtNames2, 1), 1) = vrtNames2
End If




"Steveb" wrote:

Hi

I am trying to list the file path and all files in a directory on an Excel
spreadsheet for an inventory ready for Freedom of Information legislation.
With the help of a friend I have come up with the following code;

Sub folders()

'Worksheets.Add
Sheets.Add after:=Worksheets(1)
ActiveSheet.Name = "Folders " & Format(Now, "dd-mmm-yyyy hh-mm-ss AM/PM")

' Set column headings
With Range("A1")
.FormulaR1C1 = "File Path"
End With

' Set column widths
Range("A:A").ColumnWidth = 65

' Parameter to create listing
ListFolders "C:\", True
'Columns(1).AutoFit


End Sub

Sub ListFolders(Src As String, IncSub As Boolean)
Dim FSO As Object
Dim F As Object
Dim SubF As Object
Dim r As Long

On Error Resume Next

Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.GetFolder(Src)
r = Cells(65536, 1).End(xlUp).Row + 1
Cells(r, 1).Value = F.path
If IncSub Then
For Each SubF In F.SubFolders
ListFolders SubF.path, True
Next SubF
End If

What it does not do is give me the individual file names and ideally I would
like the individual directories and sub directories in seperate columns. Can
anyone give me a pointer?

Thanks
SteveB