Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type


Sub ListFiles()
    Dim Msg As String
    Dim Directory As String, f As String
    Dim r As Long
.
.
.
[...]
.
.
.
' Analiza wyniku
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type


Sub ListFiles()
    Dim Msg As String
    Dim Directory As String, f As String
    Dim r As Long
    
    Msg = "Wybierz katalog zawierający pliki, które chcesz wyświetlić."
    Directory = GetDirectory(Msg)
    If Directory = "" Then Exit Sub
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
    r = 1

' Wstawienie nagłówków
    Cells.ClearContents
    Cells(r, 1) = "Nazwa pliku"
    Cells(r, 2) = "Rozmiar"
    Cells(r, 3) = "Data/godzina"
    Range("A1:C1").Font.Bold = True
    
' Pobranie pierwszego pliku
    f = Dir(Directory, 7)
    Do While f <> ""
        r = r + 1
        Cells(r, 1) = f
        Cells(r, 2) = FileLen(Directory & f)
        Cells(r, 3) = FileDateTime(Directory & f)
    ' Pobranie następnego pliku
        f = Dir
    Loop
End Sub


Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer

' Główny kataloog = Pulpit
    bInfo.pidlRoot = 0&

' Tytuł w oknie dailogowym
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Wybierz folder."
    Else
        bInfo.lpszTitle = Msg
  End If

' Typ katalogu, który będzie zwrócony
    bInfo.ulFlags = &H1

' Wyświetlenie okna dialogowego
    x = SHBrowseForFolder(bInfo)

' Analiza wyniku
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function