'
'******** 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
'
'
'******** 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
'
'
'******** 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
'
'
'******** 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
'
