List files from a direcotry

[Steveb]

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

 

[Jim Cone]

Steveb,

My Excel add-in "List Files" does that.
It searches for the file type you specify or for all files.
Files and folders in the specified directory are listed.
Sub-folders also listed if specified by user
File name, size, date, type are provided
Directories/folder path is listed in one column and files in the adjacent column.
Each file is hyperlinked.
Available - free - upon direct request.
Remove xxx from my email address

Regards,
Jim Cone
San Francisco, CA
(e-mail address removed)

 

[Chip Allee]

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