ファイルの全てのプロパティを取得する関数

以下を参考に作成しています。

https://excel-ubara.com/excelvba4/EXCEL_VBA_426.html

getExtendedProperty 関数

この関数は、指定されたファイルの拡張プロパティを取得し、配列に格納します。

Private Function getExtendedProperty(ByVal aFilePath As String) As Variant()
    Dim rtnAry() As Variant
    ReDim rtnAry(1 To 500, 1 To 2)
  
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    Dim sh As Object
    Set sh = CreateObject("Shell.Application")
    Dim shFolder As Object
    Dim shFile As Object
    Set shFolder = sh.Namespace(fso.GetParentFolderName(aFilePath))

    Dim i As Long
    Set shFile = shFolder.ParseName(fso.GetFileName(aFilePath))
    
    For i = 1 To 500
        rtnAry(i, 1) = shFolder.GetDetailsOf(Nothing, i)
        rtnAry(i, 2) = shFolder.GetDetailsOf(shFile, i)
    Next
    
    getExtendedProperty = rtnAry
End Function

配列の初期化:
- Dim rtnAry() As Variant と ReDim rtnAry(1 To 500, 1 To 2) で、500×2のサイズの配列を宣言します。
FileSystemObjectの作成:
- Set fso = CreateObject("Scripting.FileSystemObject") で、FileSystemObjectを作成し、ファイルシステム操作を行えるようにします。
Shell.Applicationの作成:
- Set sh = CreateObject("Shell.Application") で、Shell.Applicationオブジェクトを作成し、ファイルの詳細情報を取得するために使用します。
ファイル情報の取得:
- Set shFolder = sh.Namespace(fso.GetParentFolderName(aFilePath)) で、ファイルの親フォルダを取得します。
- Set shFile = shFolder.ParseName(fso.GetFileName(aFilePath)) で、フォルダ内の特定のファイルを取得します。
プロパティの取得:
- For i = 1 To 500 ループで、500までのプロパティを取得します。
- rtnAry(i, 1) = shFolder.GetDetailsOf(Nothing, i) は、プロパティの名前を取得します。
- rtnAry(i, 2) = shFolder.GetDetailsOf(shFile, i) は、ファイルのプロパティの値を取得します。

使用例 Sub

このサブルーチンは、ユーザーにファイルを選択させ、そのファイルの拡張プロパティをシートに表示します。

Sub 使用例()
    
    ' ファイル選択ダイヤログボックス
    Dim myTitle As String
    myTitle = "入力ファイル"
    Dim fileName As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .InitialFileName = ThisWorkbook.Path & "\"
        .AllowMultiSelect = False
        .Title = myTitle
        If .Show = True Then
            fileName = .SelectedItems(1)
        End If
    End With
        
    ' 全てのプロパティを取得
    Dim s
    s = getExtendedProperty(fileName)
    
    Dim rng As Range
    ' アクティブシートのセルA1
    Set rng = ActiveSheet.Range("A1")
    
    ' 「二次元配列」を「シート」に入れる
    Call array_to_sheet(s, rng)
End Sub

ファイル選択ダイアログボックスの表示:
- With Application.FileDialog(msoFileDialogFilePicker) でファイル選択ダイアログを表示し、ユーザーにファイルを選択させます。
- 選択されたファイルのパスは fileName に格納されます。
拡張プロパティの取得:
- s = getExtendedProperty(fileName) で、選択されたファイルのプロパティを取得します。
セル範囲の設定:
- Set rng = ActiveSheet.Range("A1") で、データを表示するセル範囲の開始位置を設定します。
プロパティの表示:
- Call array_to_sheet(s, rng) で、取得したプロパティをシートに表示します。

array_to_sheet Sub

このサブルーチンは、二次元配列の内容を指定したシートのセル範囲に書き込みます。

'*******
'* 「二次元配列」を「シート」に入れるプロシージャ。20230707
'* SheetName：シート名前
'* myArray：二次元配列。参照渡し。配列は、モジュールレベル変数としている。
'* FirstRange：配列を入れる先頭のRange
Private Sub array_to_sheet(ByRef myArray As Variant, ByVal FirstRange As Range)
    FirstRange.Resize(UBound(myArray), UBound(myArray, 2)) = myArray
End Sub

配列の内容をセル範囲に書き込み:
- FirstRange.Resize(UBound(myArray), UBound(myArray, 2)) = myArray で、配列のサイズにセル範囲をリサイズし、配列の内容をセルに書き込みます。
- このサブルーチンの説明は、以下を参照してください。