EXCEL VBA Dir関数の使い方（ファイルを検索・フォルダーを検索）

EXCEL VBA Dir関数の使い方（ファイルを検索・フォルダーを検索）

EXCEL VBA 指定したファイルを検索してファイル存在の有無を確認する。

'
'******** AKIRA55.COM ******* https://akira55.com/dir/
'

Sub Dir関数01() '指定したファイルの存在を確認します。

    Dim Check_File As String
    
    Check_File = Dir("C:\TEST\sample01.txt") 'ファイルを検索します。
    
    If Check_File <> "" Then
            MsgBox "ファイルが存在します。"  'ファイルがある場合(ファイル名とメッセージを表示)
        Else
            MsgBox "ファイルがありません。" 'ファイルがない場合（メッセージを表示）
    End If

End Sub
'

EXCEL VBA 指定したフォルダーを検索してフォルダー存在の有無を確認する。

'
'******** AKIRA55.COM ******* https://akira55.com/dir/
'

Sub Dir関数02()  '指定したフォルダーの存在を確認します。

    Dim Check_Dir As String
    
    Check_Dir = Dir("C:\TEST", vbDirectory)  '引数に「vbDirectory」を指定する事で、
    
    If Check_Dir <> "" Then
            MsgBox Check_Dir & "フォルダーが存在します。"  'フォルダーがある場合(フォルダー名とメッセージを表示)
        Else
            MsgBox "ファイルがありません。"  'フォルダーがない場合（メッセージを表示）
    End If

End Sub
'

EXCEL VBA 指定したフォルダーを検索してファイルとフォルダーの一覧表示する。

'
'******** AKIRA55.COM ******* https://akira55.com/dir/
'

Sub Dir関数03()  '指定したフォルダー内を一覧表示します。

    Dim Check_Dir, SetFile As String
    Dim I As Long
    
    Cells.ClearContents 'シートの文字列を全て削除
    
    I = 2  '2行目から表示

    Check_Dir = "C:\Akira55\"
    
    Cells(1, "A").Interior.ColorIndex = 22
    Cells(1, "A") = "フォルダー内一覧"
    
    SetFile = Dir(Check_Dir, vbNormal + vbDirectory)  '普通ファイルとフォルダーを指定（ vbNormal + vbDirectory）

    Do Until SetFile = ""    'ファイルとフォルダーがなくなるまで繰り返す
        
        If "." <> SetFile And ".." <> SetFile Then  'カレントフォルダー・親フォルダー以外を表示させる。
            Cells(I, "A") = SetFile  'ファイル名または、フォルダー名をA列に表示します。

            I = I + 1  '１行加算する。
        End If
        
    SetFile = Dir  '次のファイルかフォルダー取得
    
    Loop  '繰り返す。

End Sub
'

EXCEL　VBA　ダイアログボックスで選択したファイルの拡張子（種類）ごとに、ファイルをワークシートに振り分る

'
'******** AKIRA55.COM ******* https://akira55.com/dir/
'
Sub Dir関数04()  'ダイアログボックスで選択したファイルの拡張子（種類）毎に、ファイルをワークシートに振り分けます。
 
    Dim Ext_Collection As New Collection
    Dim FileList As Variant
    Dim FileName, Extension As String
    Dim I, L, M, X, lRow, lCol As Long
 
   
    Cells.Clear  'シートをクリアー
     
    FileList = Application.GetOpenFilename(FileFilter:="ファイル(*.*),*.*", MultiSelect:=True)  'ダイアログボックスを開きます（複数選択可能：MultiSelect:=True）
     
    If VarType(FileList) = vbBoolean Then   'ファイルを選択していなければ、プログラム終了
        Exit Sub
    End If
    
    On Error Resume Next  'エラーが発生しても続行する。
    
    For I = 1 To UBound(FileList)  '選択したファイルを最後まで繰り返す。
    
        L = InStrRev(FileList(I), "\")
        FileName = Mid(FileList(I), L + 1)  'パスからファイル名を抜き出す。
    
        M = InStrRev(FileName, ".")
        Extension = Mid(FileName, M + 1)  'ファイル名から拡張子を抜き出す。
        
        Ext_Collection.Add Extension, Extension '一意のデータを作成（拡張子）
        
    
    Next I
    
    On Error GoTo 0
    
    For I = 1 To Ext_Collection.Count  '１行目に一意のデータを表示する。B⇒G
    
        Cells(1, I + 1) = Ext_Collection(I)  '一意のデータを順番に１行目に表示する。
        Cells(1, I + 1).Interior.ColorIndex = I + 2  '１行目に背景色を塗りつぶす。３番の赤より～
    Next I
    
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column  '一意のデータを代入された最終列を取得（列番号）
    
    For I = 1 To UBound(FileList)  ''選択したファイルを最後まで繰り返す。
    
        L = InStrRev(FileList(I), "\")
        FileName = Mid(FileList(I), L + 1)   'パスからファイル名を抜き出す。
    
        M = InStrRev(FileName, ".")
        Extension = Mid(FileName, M + 1)      'ファイル名から拡張子を抜き出す。
        
        For X = 2 To lCol
            If Extension = Cells(1, X) Then  '１列名に表示されている拡張子と選択ファイルの拡張子が一致するか確認する。
                lRow = Cells(Rows.Count, X).End(xlUp).Row + 1  '拡張子が一致した場合は、該当する拡張子の列の最終行＋１を取得する。
                Cells(lRow, X) = FileName  '一致した拡張子の最終行＋１にファイル名を記入する。
            End If
        Next X
    
    Next I
    
        
End Sub
'