klasördeki excellerin properties bölümündeki başlıkları listelemek

[kalimera55]

Merhaba,
Klasör içindeki büyün excellerin dosyaadı + başlık bilgisi ni döküm halinde almam gerekiyor.
Dosya adı, değiştirme tarihi, boyutu vb şeyleri listeleyebiliyorum fakat başlık kısmını listelemenin yöntemini bulmadım.
Yardımcı olursanız sevinirim.

 

[necati]

Daha önce paylaşılmış bir örnek,
Başlık bilgisi 21. sütunda/sırada bulunuyor.

Sub DOSYA_OZELLIKLERI()
    Dim Klasör As Object, Klasör_Yolu As String, Dosya As Object, Satır As Long, X As Integer
        
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
    Klasör_Yolu = Klasör.Items.Item.Path
    If Klasör_Yolu = "" Then Exit Sub
    Cells.ClearContents
    Range("A1") = "Dosya Adı"
    
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasör_Yolu).Files
        Satır = Satır + 1
        Set Dosya = CreateObject("Shell.Application").Namespace(Klasör).ParseName(Dosya.Name)
        Cells(Satır + 1, "A") = Dosya.Name
        Cells(Satır + 1, "A").Hyperlinks.Add Anchor:=Cells(Satır + 1, "A"), Address:=Dosya.Path, TextToDisplay:=Dosya.Name
        
        For X = 1 To 40
            Cells(1, X + 1) = CreateObject("Shell.Application").Namespace(Klasör).GetDetailsOf("", X)
            Cells(Satır + 1, X + 1) = CreateObject("Shell.Application").Namespace(Klasör).GetDetailsOf(Dosya, X)
        Next
    Next
    
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub