Sub PrintFilesInfo()
    Const myPATH = "C:\tmp"

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets(1)
    sh.Cells.Clear
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(myPATH) Then
        Dim oFold As Object
        Set oFold = fso.GetFolder(myPATH)
        
        Dim n As Long
        n = oFold.Files.Count
        If n > 0 Then
            Dim arr As Variant
            Dim brr As Variant
            Dim hrr As Variant
            hrr = Array("Имя:", "Размер:", "Тип:", "Изменен:", "Создан:", "Открыт:", "Атрибут:", "Состояние:", "Владелец:", "Автор:", "Заголовок:", "Тема:", "Категории:", "Страницы:", "Комментарий:")
            ReDim arr(1 To n + 1, 1 To UBound(hrr) + 2)
            Dim vFile As Variant
            Dim y As Long
            Dim x As Byte
            Dim h As Byte
            y = 1
            For Each vFile In oFold.Files
                brr = GetFileInfo(myPATH, fso.GetFileName(vFile))
                y = y + 1
                x = 0
                For h = 0 To UBound(brr)
                    Select Case h
                    Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
                        x = x + 1
                        arr(y, x) = brr(h)
                        If y = 2 Then arr(1, x) = hrr(h)
                    End Select
                Next
            Next
            sh.Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
        End If
    End If
    
    
End Sub

Function GetFileInfo(PathName As String, FileName As String, Optional i& = 9)
'https://www.planetaexcel.ru/forum/?FID=8&PAGE_NAME=read&TID=28973
 ' ZVI:2011-08-29 http://www.planetaexcel.ru/forum.php?thread_id=31105
 ' Получение свойств файла
 '-------------------
 ' PathName - папка
 ' FileName -
 ' i - номер свойства
 '-------------------
 'i=0 - Имя, 1 - Размер, 2 - Тип, 3 - Изменен, 4 - Дата создания, 5 - Открыт
 'i=6 - Атрибуты, 7 - Состояние, 8 - Владелец,  9 - Автор,10 - Заголовок
 'i=11 - Тема, 12 - Категория, 13 - Страницы, 14 - Комментарий
 Dim a$(0 To 15), j&
 If Dir(PathName & IIf(Right(PathName, 1) <> "\", "\", "") & FileName) = "" Then Exit Function
 With CreateObject("Shell.Application").Namespace((PathName))
   For j = 0 To 14
     a(j) = .GetDetailsOf(.ParseName((FileName)), j)
   Next
 End With
 GetFileInfo = a
End Function
 
Sub ShowFileInfo()
 Dim x
 x = GetFileInfo("C:\temp\ScreenSaverPhotos", "1. Мобильное приложение ProSIBINTEK.jpg")
 If IsArray(x) Then
   Debug.Print "Имя:", x(0)
   Debug.Print "Размер:", x(1)
   Debug.Print "Тип:", x(2)
   Debug.Print "Изменен:", x(3)
   Debug.Print "Создан:", x(4)
   Debug.Print "Открыт:", x(5)
   Debug.Print "Атрибут:", x(6)
   Debug.Print "Состояние:", x(7)
   Debug.Print "Владелец:", x(8)
   Debug.Print "Автор:", x(9)
   Debug.Print "Заголовок:", x(10)
   Debug.Print "Тема:", x(11)
   Debug.Print "Категории:", x(12)
   Debug.Print "Страницы:", x(13)
   Debug.Print "Комментарий:", x(14)
 Else
   Debug.Print "Файл не найден"
 End If
End Sub