異なる拡張子のファイルのプロパティ情報を一括で出力したい

Question

実現したいこと

複数のフォルダ内に1300件ほどあるExcelやWord、PDF、JPGといった異なる拡張子のデータファイルのプロパティ情報を一括で出力したいです。

実現方法が全く分からず、皆様のお力添えをいただけますと幸いです。

発生している問題・分からないこと

フリーソフトを入れることができない状況の為、可能であればVBAで対処したいと考えているのですが、実現方法がわかりません。
調べてみるとOffice系のデータであれば対応可能なコード（下記に記載します）を見つけることができましたが、PDFやJPG等も一括で取得したいです。

該当のソースコード

Sub sample()
　　Dim i As Long
　　Dim strFile As String
　　Dim strPath As String
　　Dim obj As Object
　　
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.InitialFileName = "C:\"
　　　　.AllowMultiSelect = False
　　　　.Title = "フォルダの選択"
　　　　If .Show = False Then
　　　　　　Exit Sub
　　　　End If
　　　　strPath = .SelectedItems(1) & "\"
　　End With
　　
　　Application.EnableEvents = False '起動時のOpenイベント等を停止
　　On Error Resume Next 'GetObjectで取得できないファイルの対策
　　strFile = Dir(strPath)
　　i = 2
　　Do While strFile <> ""
　　　　Cells(i, 1) = strFile 'ファイル名
　　　　Cells(i, 2) = FileDateTime(strPath & strFile) '更新日時
　　　　Cells(i, 3) = FileLen(strPath & strFile) 'サイズ
　　　　Set obj = GetObject(strPath & strFile)
　　　　If Err.Number <> 0 Then
　　　　　　'Officeのドキュメントではないということ
　　　　　　Err.Clear
　　　　Else
　　　　　　Cells(i, 4).Value = obj.BuiltinDocumentProperties(3) 'Author
　　　　　　Cells(i, 5).Value = obj.BuiltinDocumentProperties(7) 'Last Author
　　　　　　obj.Close
　　　　End If
　　　　strFile = Dir()
　　　　i = i + 1
　　Loop
　　Set obj = Nothing
　　Application.EnableEvents = True
End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

言葉を変えて検索をしてみましたが、同様の質問を見つけることができませんでした。

補足

最終的に画像のような項目で表形式になるようにしたいです。
宜しくお願い致します。

Answer 1

「プロパティ情報」って何ですか？
出力formを見ると作成者、所有者、作成日、更新日、サイズ ですか？
所有者以外はとれますが、所有者はものによります。
Officeのfileは file のデータの中に それらの情報を持っていますが他のものは必ずしも、なので
例えば下のようなのは？
作成者が採れるかどうかは相手次第ですが。

Sub GetFileInfo()
    Dim filePath As String
    Dim fileSystem As Object
    Dim file As Object
    
    ' ファイルのパスを指定します
    filePath = "C:\Path\To\Your\File.xlsx"
    
    ' FileSystemObject を作成します
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    
    ' ファイルが存在することを確認します
    If fileSystem.FileExists(filePath) Then
        ' ファイルオブジェクトを取得します
        Set file = fileSystem.GetFile(filePath)
        
        ' ファイルのプロパティから作成者情報を取得します
        Dim createdDate As Date
        Dim modifiedDate As Date
        Dim owner As String
        Dim createdUser As String
        
        createdDate = file.DateCreated
        modifiedDate = file.DateLastModified
        owner = file.owner
        
        ' 作成者情報を取得する
        createdUser = GetFileCreator(filePath)
        
        ' メッセージボックスに情報を表示します
        MsgBox "作成者: " & createdUser & vbCrLf & _
               "作成日: " & createdDate & vbCrLf & _
               "更新日: " & modifiedDate & vbCrLf & _
               "所有者: " & owner
        
    Else
        MsgBox "ファイルが見つかりません。"
    End If
End Sub

Function GetFileCreator(ByVal filePath As String) As String
    Dim fileAttributes() As String
    Dim shell As Object
    Dim objFolder As Object
    Dim objFile As Object
    
    Set shell = CreateObject("Shell.Application")
    Set objFolder = shell.Namespace(GetParentFolder(filePath))
    Set objFile = objFolder.ParseName(GetFileName(filePath))
    
    If Not objFile Is Nothing Then
        ReDim fileAttributes(1 To 266)
        For i = 0 To 266
            fileAttributes(i + 1) = objFolder.GetDetailsOf(objFile, i)
        Next i
    End If
    
    GetFileCreator = fileAttributes(20) ' 作成者情報のインデックス番号は20です
End Function

Function GetParentFolder(ByVal filePath As String) As String
    GetParentFolder = Left(filePath, InStrRev(filePath, "\") - 1)
End Function

Function GetFileName(ByVal filePath As String) As String
    GetFileName = Mid(filePath, InStrRev(filePath, "\") + 1)
End Function

Comments

[shibakoppe]

ご回答いただきありがとうございます。
＞＞プロパティ情報
ファイルのプロパティの詳細タブに記載されている情報を抽出したかったのです。

ご提示いただいたコードについて、ファイルのパスを指定されていると思うのですが、
複数の拡張子に対して対応するためには指定をし直す必要があるということでしょうか…？

[winterboum]

ああ、ごめんなさい、「プロパティ情報をとる」ところしかきにしていなかった。
あなたのプログラムの Do While strFile <> "" ループの strFile がそれです。
ループのなかのプロパティを得るところを
' ファイルオブジェクトを取得します
' ファイルのプロパティから作成者情報を取得します
' 作成者情報を取得する
にしていただく。
変数名は修正してください