1st module :

Function BrowseFolder() As String

    

    Const szINSTRUCTIONS As String = "Choose the folder to use for this operation." & vbNullChar

    

    Dim uBrowseInfo As BROWSEINFO

    Dim szBuffer As String

    Dim lID    As Long

    Dim lRet   As Long

    

    With uBrowseInfo

        .hOwner = 0

        .pidlRoot = 0

        .pszDisplayName = String$(MAX_PATH, vbNullChar)

        .lpszINSTRUCTIONS = szINSTRUCTIONS

        .ulFlags = BIF_RETURNONLYFSDIRS

        .lpfn = 0

    End With

    

    szBuffer = String$(MAX_PATH, vbNullChar)

    

     ''' Show the browse dialog.

    lID = SHBrowseForFolderA(uBrowseInfo)

    

    If lID Then

         ''' Retrieve the path string.

        lRet = SHGetPathFromIDListA(lID, szBuffer)

        If lRet Then BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)

    End If

    

End Function

 

2^nd module :

 

Option Explicit

 

Sub CreateList()

    Application.ScreenUpdating = False

    Worksheets.Add ' create a new worksheet for the folder list

    'Worksheets.Name = SourceFolder.Name

     ' 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 (Mo):"

    Cells(3, 4).Value = "Subfolders:"

    Cells(3, 5).Value = "Files:"

    Cells(3, 6).Value = "Short Name:"

    Range("A3:G3").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(1, 2).Value = SourceFolder.Path

    Cells(r, 1).Value = SourceFolder.Path

    Cells(r, 2).Value = SourceFolder.Name

    Cells(r, 3).Value = SourceFolder.Size / 1000000

    Cells(r, 3).NumberFormat = "0.00"

    Cells(r, 4).Value = SourceFolder.SubFolders.Count

    Cells(r, 5).Value = SourceFolder.Files.Count

    Cells(r, 6).Value = SourceFolder.ShortName

    If IncludeSubfolders Then

        For Each SubFolder In SourceFolder.SubFolders

            ListFolders SubFolder.Path, True

        Next SubFolder

        Set SubFolder = Nothing

    End If

    Columns("A:G").AutoFit

    Set SourceFolder = Nothing

    Set FSO = Nothing

    ActiveWorkbook.Saved = True

    

End Sub