【VBA】ファイル一覧をシートに表示する

0

    <機能>
    (1)ファイル一覧(サブフォルダを含む)を取得してシートに表示します
    (2)サブフォルダは再帰的に読み込みます

     

    <イメージ>

     

    VBA.ファイル一覧,サブフォルダ,CreateObject,


    <使い方>
    一番簡単なのはThisWorkbookにそのまま張り付けてください
    色々アレンジしても面白いと思います
     

    '//ワークブックオープンでフォルダ選択ダイアログを表示
    Private Sub Workbook_Open()
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                ファイル一覧 .SelectedItems(1)
            End If
        End With
    End Sub

    '//選択されたフォルダのファイル一覧を取得するプロシージャをコール
    Sub ファイル一覧(ByVal folpath As String)    
        '全て(数式、文字列、書式、コメント、アウトライン)クリア
        Cells.Select
        Selection.Clear
        '列の幅、フォントサイズをセット
        Selection.ColumnWidth = 4
        Selection.Font.Size = 9
        Range("A1").Select
        'ファイル一覧をサブフォルダまで取得して表示する
        Application.ScreenUpdating = False
        Call ファイル一覧を取得(folpath, 1, 0)
        Application.ScreenUpdating = True
        '終了メッセージ
        MsgBox "おわりました", vbInformation
    End Sub

    '//ファイル一覧を再帰的に取得してシートに表示する
    '//引数 gyo:出力開始行番号
    '//   clm:出力開始列番号(1列目からの相対値)

    Sub ファイル一覧を取得(ByVal folpath As String, ByRef gyo As Long, ByVal clm As Integer)
        Dim buf As String
        Dim fol As Object
        'ルートフォルダを表示
        Cells(gyo, 1) = "【" & CStr(gyo) & "】"
        Cells(gyo, 2 + clm) = folpath
        gyo = gyo + 1
        'ファイル一覧を取得
        buf = Dir(folpath & "¥*.*", vbNormal)
        Do While buf <> ""
            Cells(gyo, 1) = "【" & CStr(gyo) & "】"
            Cells(gyo, 2 + clm) = ""
            Cells(gyo, 2 + clm + 1) = buf
            gyo = gyo + 1
            buf = Dir()
        Loop
        'サブフォルダからファイル一覧を取得
        With CreateObject("Scripting.FileSystemObject")
            For Each fol In .getFolder(folpath).SubFolders
                Call ファイル一覧を取得(fol.Path, gyo, clm + 1)
            Next fol
        End With
    End Sub

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    selected entries

    categories

    calendar

    S M T W T F S
        123
    45678910
    11121314151617
    18192021222324
    252627282930 
    << November 2018 >>

    profile

    others

    archives