Directory incl sub dirs incl bestandsnamen

[jolanda05031975]

Ik heb nu een vba script waarbij netjes heel de directory structuur wordt getoond. Het lukt mij alleen niet om de bestandsnamen welke in de directory's zitten incl extentie erbij te krijgen.

Het zit er zo uit

Folder Path Folder Name Size Subfolders Files ShortName Short Path

Hoe krijg ik dit voor elkaar?

Sub CreateList()
Application.ScreenUpdating = False
Workbooks.Add ' create a new workbook for the folder list
' add headers
With Cells(1, 1)
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Cells(3, 1).Value = "Folder Path:"
Cells(3, 2).Value = "Folder Name:"
Cells(3, 3).Value = "Size:"
Cells(3, 4).Value = "Subfolders:"
Cells(3, 5).Value = "Files:"
Cells(3, 6).Value = "Short Name:"
Cells(3, 7).Value = "Short Path:"
Cells(3, 8).Value = "Short Path:"
Cells(3, 9).Value = "Short Path:"
Range("A3:I3").Font.Bold = True
ListFolders BrowseFolder, True
Application.ScreenUpdating = True
End Sub

Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the folders in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
' display folder properties
r = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(r, 1).Value = SourceFolder.Path
Cells(r, 2).Value = SourceFolder.Name
Cells(r, 3).Value = SourceFolder.Size
Cells(r, 4).Value = SourceFolder.SubFolders.Count
Cells(r, 5).Value = SourceFolder.Files.Count
Cells(r, 6).Value = SourceFolder.Name
Cells(r, 7).Value = SourceFolder.ShortPath
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFolders SubFolder.Path, True
Next SubFolder
Set SubFolder = Nothing
End If
Columns("A:I").AutoFit
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True

End Sub

 

[HSV]

Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the folders in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long[COLOR=#0000ff], bnm As Object[/COLOR]
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
' display folder properties
r = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(r, 1).Value = SourceFolder.Path
Cells(r, 2).Value = SourceFolder.Name
Cells(r, 3).Value = SourceFolder.Size
Cells(r, 4).Value = SourceFolder.SubFolders.Count
Cells(r, 5).Value = SourceFolder.Files.Count
Cells(r, 6).Value = SourceFolder.Name
Cells(r, 7).Value = SourceFolder.ShortPath
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFolders SubFolder.Path, True
[COLOR=#0000ff]For Each bnm In SubFolder.Files[/COLOR]
[COLOR=#0000ff]Cells(r, 10) = bnm.Name[/COLOR]
[COLOR=#0000ff]Next bnm[/COLOR]


Next SubFolder
Set SubFolder = Nothing
End If
Columns("A:I").AutoFit
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True


End Sub

 

[jolanda05031975]

Bedankt het probleem is inmiddels opgelost

 

[HSV]

Mag ik ook weten hoe en door wie (welk forum)?

 

[jolanda05031975]

Na veel zoeken op internet heb ik een andere versie gevonden.

Super bedankt in ieder geval.

Ik ga deze ook nog een keer doornemen. Deze is anders opgesteld dan welke ik nu heb.

 

[HSV]

Misschien wil je die versie beschikbaar stellen aan andere bezoekers van dit forum.