Dir関数を使用したファイルの取得

シートに指定したフォルダとファイル一覧を書き出し、そのファイルをエクセル上から参照(ハイパーリンクで)できるようにしたVBA。Dir関数で取得したファイル名(フルパス)の後処理は別の機会に。

また、サブフォルダごとファイル名を取得したい場合は別記事の Dir関数でサブフォルダを含めたファイル値の取得 を参照。当記事はDir関数の基本的な使い方と、ちょっとした応用(Loop処理)の紹介記事。

 

 


Dir関数でファイル値を取得する

 

変数宣言値
Dim f As Long, buf As String, Path As String, FolderName As String
Dim Rg As Range

フォルダ選択関数
Function SelectFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
SelectFolder = .SelectedItems(1)
End With
End Function

フォルダ選択関数(Function SelectFolder())でダイアログを開きフォルダを指定し、その一覧を任意の場所に書き出すマクロ。Dir関数でファイル名を任意のセルに書き出し。ファイルの指定にはワイルドカードを使用する。Dir(パス & “\*.*”) ※.jpgのみや.tiffのみを取り出したい場合は拡張子後のワイルドカードを変える

Path = SelectFolder() ’ ダイアログで指定したフォルダ
If Path = “” Then Exit Sub ’ 何も指定しなかったら終わってね、の指示
buf = Dir(Path & “\*.*”) ’ ここでDir関数(bufの変数はファイル名)

任意の場所にフォルダ名を記述させる。
FolderName = Dir(Path, vbDirectory) ’ フォルダの名前=vbDirectory、Dirで抜き出す
Range(“任意のセル”).Value = FolderName

ループで実行
Do While buf <> “”
If f < 30 Then ’ f(この場合はファイル数)の値が30未満なら繰り返し実行

取得したファイル名を任意のセルに書き出す
Set Rg = (“任意のセル”).Offset(f) ‘←ここにfの変数(Offset関数により1行ずつ下に)
Rg.Value = buf

ファイルのフルパスを右隣に表示
Set Rg = Rg.Offset(0, 1)
Rg.Value = Path & “\” & buf

フルパスにハイパーリンクを設定
ActiveSheet.Hyperlinks.Add Anchor:=Rg, Address:=Rg.Value

f = f + 1 ‘変数fに+1をする(ループ時のOffsetの値で1行下に)
buf = Dir()

上記「If f < 30 Then」の対(fの値が30を超えた)場合は処理を停止
Else
MsgBox “全部で30個以上のファイルが見つかりました”
Exit Sub
End If
Loop ’ 上記Do While buf <> “”によりファイルが見つからなくなるまで繰り返し実行
MsgBox “全部で” & ” ” & f & ” ” & “個のファイルが見つかりました”
End Sub

以上、説明終わり。

 

 


コピペ用サンプルコード

 

Sub Sample_FL()
Dim f As Long, buf As String, Path As String, FolderName As String
Dim Rg As Range

Path = SelectFolder()
If Path = “” Then Exit Sub
FolderName = Dir(Path, vbDirectory)
buf = Dir(Path & “\*.*”)
Range(“任意のセル”).Value = FolderName
Do While buf <> “”
If f < 30 Then
Set Rg = ActiveCell.Offset(f)
Rg.Value = buf
Set Rg = Rg.Offset(0, 1)
Rg.Value = Path & “\” & buf
ActiveSheet.Hyperlinks.Add Anchor:=Rg, Address:=Rg.Value
f = f + 1
buf = Dir()
Else
MsgBox “全部で30個以上のファイルが見つかりました”
Exit Sub
End If
Loop
MsgBox “全部で” & ” ” & f & ” ” & “個のファイルが見つかりました”
End Sub

Function SelectFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
SelectFolder = .SelectedItems(1)
End With
End Function