Sub ExtractFilePropeties()
Dim objShell As Object, objFolder As Object ' Shell & Folder
Dim strFldr, strFlNms, r As Long, c As Long
strFldr = GetFolder & "\": If strFldr = "\" Then Exit Sub
r = 1
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFldr)
With objFolder
  For c = 0 To 320
    Cells(r, c + 1) = .GetDetailsOf(.Items, c)
  Next
  Exit Sub
  For Each strFlNms In .Items
    r = r + 1
    For c = 0 To 320
      Cells(r, c + 1) = objFolder.GetDetailsOf(strFlNms, c)
    Next
  Next
End With
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function