フォルダ内ファイル情報一覧取得

指定したフォルダからファイルリストを取得する。
返却はDictionary型を使用し、キーはファイルリストがある場所の相対パスとする。
ただしカレントフォルダのみフルフォルダパスをキーとする。

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' フォルダ内ファイル情報一覧取得
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 初期化
'------------------------------------------------------------------------------
Public Sub S_File_InitInf()
    With pgInf
        .Path = ""
        .ExtSpec = ""
        .ExtSpecAry = Empty
    End With
End Sub

'------------------------------------------------------------------------------
' フォルダ内ファイル情報一覧取得
'------------------------------------------------------------------------------
Public Function F_File_GetFolderFileInfList( _
        ByRef aRtn As Dictionary, _
        ByVal aPath As String, _
        Optional ByVal aExtSpec As String = "*.*") As Boolean
    Dim wkPath As String: wkPath = M_String.F_String_ReturnDelete(aPath, "\", E_STRING_SPEC_POS_END)
    
    Dim wkChkRet As E_RET
    Dim wkExtSpecAry As Variant
    
    '再取得チェック
    wkChkRet = PF_File_CheckFileInf(wkPath, aExtSpec)
    With pgInf
        If wkChkRet = E_RET_NG Then
            '再取得不要で終了
            Exit Function
        Else
            '再取得必要な場合は取得を実施
            If wkChkRet = E_RET_OK_1 Then
                PS_File_GetFolderFileInfList_Sub .List, .Path, "", .ExtSpecAry
            End If
        End If
        
        If .List.Count > 0 Then
            Set aRtn = .List
            F_File_GetFolderFileInfList = True
        End If
    End With
End Function

' ファイル情報チェック
Private Function PF_File_CheckFileInf( _
        ByVal aPath As String, _
        ByVal aExtSpec As String) As E_RET
    Dim wkRet As E_RET: wkRet = E_RET_NG

    Dim wkFso As New FileSystemObject
    Dim wkTmpAry As Variant, wkTmp As Variant
    
    If aPath = "" Or aExtSpec = "" Or Dir(aPath, vbDirectory) = "" Then
        'パス、拡張子指定無し、フォルダが存在しない場合は対象外
        PF_File_CheckFileInf = wkRet
        Exit Function
    End If
    
    With pgInf
        'パス、拡張子指定が一致の場合は再取得不要
        If .Path = aPath And .ExtSpec = aExtSpec Then
            wkRet = E_RET_OK
        End If
            
        '再取得時は初期化
        If wkRet <> E_RET_OK Then
            .Path = aPath
            .ExtSpec = aExtSpec
            
            If M_String.F_String_GetSplitExtension(.ExtSpecAry, .ExtSpec) <> True Then
                .ExtSpecAry = Empty
            End If
                
            If Not .List Is Nothing Then
                .List.RemoveAll
            Else
                Set .List = New Dictionary
            End If
                
            wkRet = E_RET_OK_1
        End If
    End With
    
    PF_File_CheckFileInf = wkRet
End Function

'サブルーチン
Private Sub PS_File_GetFolderFileInfList_Sub( _
        ByRef aRtn As Dictionary, _
        ByVal aFullFld As String, _
        ByVal aCrtFld As String, _
        ByVal aExtSpecAry As Variant)
    Dim wkFileInfAryAry As Variant, wkFileInfAry(D_IDX_START To E_FILE_IDX_LIST_INF_EEND) As Variant
    Dim wkKeyFld As String
    
    Dim wkFso As New FileSystemObject
    Dim wkFile As File
    Dim wkFolder As Folder
    Dim wkFileNm As String
    
    Dim wkCrtFld As String: wkCrtFld = aCrtFld
    Dim wkFullFld As String: wkFullFld = aFullFld
    Dim wkRltFld As String
    
    Dim wkExtSpec As Variant
    Dim wkAddFlg As Boolean
    
    'カレントフォルダ設定
    If wkCrtFld = "" Then
        wkCrtFld = wkFullFld
        wkRltFld = ""
    Else
        '相対フォルダパス作成（フルフォルダパスからカレントフォルダパス削除）
        wkRltFld = M_String.F_String_ReturnDelete(wkFullFld, wkCrtFld, E_STRING_SPEC_POS_START)
        wkRltFld = M_String.F_String_ReturnDelete(wkRltFld, "\", (E_STRING_SPEC_POS_START Or E_STRING_SPEC_POS_END))
    End If
    
    '全ファイル確認
    For Each wkFile In wkFso.GetFolder(wkFullFld).Files
        wkFileNm = wkFile.Name
        
        '拡張子指定がある場合
        If IsArray(aExtSpecAry) = True Then
            wkAddFlg = True
            
            '拡張子指定と一致した場合は追加でループ終了
            For Each wkExtSpec In aExtSpecAry
                If wkFileNm Like wkExtSpec Then
                    wkAddFlg = True
                    Exit For
                End If
            Next wkExtSpec
        '拡張子指定がない場合
        Else
            wkAddFlg = True
        End If
        
        '追加可能な場合
        If wkAddFlg = True Then
            wkFileInfAry(E_FILE_IDX_LIST_INF_NAME) = wkFileNm
            'フルパス設定
            wkFileInfAry(E_FILE_IDX_LIST_INF_FULLPATH) = wkFile.Path
            '相対パス設定
            wkFileInfAry(E_FILE_IDX_LIST_INF_RLTPATH) = M_String.F_String_ReturnAdd(wkRltFld, wkFileNm, aDlmt:="\")
            
            'ファイル情報追加
            wkFileInfAryAry = M_Common.F_ReturnArrayAdd(wkFileInfAryAry, wkFileInfAry)
        End If
    Next wkFile
    
    'フォルダ内ファイル登録
    If wkRltFld <> "" Then
        wkKeyFld = wkRltFld
    Else
        wkKeyFld = wkCrtFld
    End If
    aRtn.Add wkKeyFld, wkFileInfAryAry
    
    'サブフォルダ検索
    For Each wkFolder In wkFso.GetFolder(wkFullFld).SubFolders
        PS_File_GetFolderFileInfList_Sub aRtn, wkFolder.Path, wkCrtFld, aExtSpecAry
    Next wkFolder
End Sub