Dir関数によるファイル操作
VBA でファイルやフォルダを扱う際、Dir 関数は最も基本的で重要な関数の一つです。特定のフォルダ内のファイル一覧を取得したり、ファイルの存在確認を行ったりする場合に必須の知識となります。
この記事では、Dir 関数の基本的な使い方から応用テクニック、FileSystemObject との比較まで、実践的なサンプルコードと共に詳しく解説します。
Dir 関数が必要となるシチュエーション
実務では、以下のような場面で Dir 関数を使用します:
- 複数ファイルの一括処理: フォルダ内のすべての Excel ファイルを開いてデータ集計
- ファイルの存在確認: 処理前に特定のファイルが存在するかチェック
- バックアップファイルの作成: 既存ファイルがあれば連番を付けて保存
- ログファイルの管理: 古いログファイルを削除
- レポート生成: 特定パターンのファイルを検索して一覧作成
- データ移行: フォルダ内のすべての CSV ファイルをインポート
Dir 関数の基本
基本構文
Dir([パス名], [属性])
Dir 関数は、指定されたパターンに一致する最初のファイルまたはフォルダ名を返します。
最もシンプルな使い方
Sub DirBasic()
Dim fileName As String
' カレントフォルダ内の最初のファイルを取得
fileName = Dir("*.*")
Debug.Print "最初のファイル: " & fileName
End Sub
Dir関数を初めて呼び出すときはパスを指定し、2回目以降は引数なしで呼び出すことで、次のファイルを取得できます。
ファイル一覧の取得
Sub GetFileList()
Dim folderPath As String
Dim fileName As String
' フォルダパスを指定
folderPath = "C:\Users\YourName\Documents\"
' 最初のファイルを取得
fileName = Dir(folderPath & "*.*")
' すべてのファイルをループ
Do While fileName <> ""
Debug.Print fileName
' 次のファイルを取得
fileName = Dir()
Loop
End Sub
Dir関数は最初の呼び出しでパスを指定し、その後は引数なしでDir()を呼び出すことで、同じ検索条件で次のファイルを取得します。すべてのファイルを取得し終えると空文字列("")を返します。
ワイルドカードの使用
Dir 関数では、ワイルドカード(*と?)を使用してパターンマッチングができます:
*(アスタリスク): 0 文字以上の任意の文字列?(クエスチョンマーク): 任意の 1 文字
Sub WildcardExamples()
Dim fileName As String
Dim folderPath As String
folderPath = "C:\Data\"
' すべてのファイル
Debug.Print "=== すべてのファイル ==="
fileName = Dir(folderPath & "*.*")
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
' Excelファイルのみ
Debug.Print "=== Excelファイル ==="
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
' 特定のパターン(レポート_で始まるファイル)
Debug.Print "=== レポート_* ==="
fileName = Dir(folderPath & "レポート_*.xlsx")
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
' 3文字のファイル名
Debug.Print "=== 3文字のファイル名 ==="
fileName = Dir(folderPath & "???.txt")
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
End Sub
拡張子別のファイル処理
Excel ファイルの一覧取得
Sub GetExcelFiles()
Dim folderPath As String
Dim fileName As String
Dim fileCount As Integer
folderPath = "C:\Reports\"
fileCount = 0
' .xlsxファイルを検索
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
fileCount = fileCount + 1
Debug.Print fileCount & ": " & fileName
fileName = Dir()
Loop
' .xlsmファイルも含める場合
Debug.Print "=== マクロ有効ファイル ==="
fileName = Dir(folderPath & "*.xlsm")
Do While fileName <> ""
fileCount = fileCount + 1
Debug.Print fileCount & ": " & fileName
fileName = Dir()
Loop
MsgBox "合計: " & fileCount & "個のExcelファイル", vbInformation
End Sub
複数の拡張子を処理
Sub ProcessMultipleExtensions()
Dim folderPath As String
Dim extensions() As Variant
Dim ext As Variant
Dim fileName As String
folderPath = "C:\Documents\"
extensions = Array("*.xlsx", "*.xlsm", "*.xls", "*.csv")
For Each ext In extensions
Debug.Print "=== " & ext & " ==="
fileName = Dir(folderPath & ext)
Do While fileName <> ""
Debug.Print " " & fileName
fileName = Dir()
Loop
Next ext
End Sub
Dir関数は一度に1つのパターンしか処理できません。複数の拡張子を処理する場合は、上記のようにループで回す必要があります。
ファイル属性の指定
Dir 関数の第 2 引数で、ファイル属性を指定できます:
| 定数 | 値 | 説明 |
|---|---|---|
| vbNormal | 0 | 通常のファイル(デフォルト) |
| vbReadOnly | 1 | 読み取り専用ファイル |
| vbHidden | 2 | 隠しファイル |
| vbSystem | 4 | システムファイル |
| vbVolume | 8 | ボリュームラベル |
| vbDirectory | 16 | フォルダ |
| vbArchive | 32 | アーカイブ属性 |
Sub GetFilesWithAttributes()
Dim folderPath As String
Dim fileName As String
folderPath = "C:\Data\"
' 通常のファイル(デフォルト)
Debug.Print "=== 通常のファイル ==="
fileName = Dir(folderPath & "*.*", vbNormal)
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
' 隠しファイルを含む
Debug.Print "=== 隠しファイルを含む ==="
fileName = Dir(folderPath & "*.*", vbHidden + vbNormal)
Do While fileName <> ""
Debug.Print fileName
fileName = Dir()
Loop
' フォルダのみ
Debug.Print "=== フォルダのみ ==="
fileName = Dir(folderPath & "*.*", vbDirectory)
Do While fileName <> ""
' "."と".."を除外
If fileName <> "." And fileName <> ".." Then
' フォルダかどうか確認
If (GetAttr(folderPath & fileName) And vbDirectory) = vbDirectory Then
Debug.Print fileName
End If
End If
fileName = Dir()
Loop
End Sub
vbDirectoryを指定すると、フォルダだけでなくファイルも含まれます。フォルダのみを取得するには、GetAttr関数で確認が必要です。
ファイルの存在確認
Function FileExists(filePath As String) As Boolean
' ファイルが存在する場合、ファイル名が返る
' 存在しない場合、空文字列が返る
FileExists = (Dir(filePath) <> "")
End Function
Sub CheckFileExistence()
Dim filePath As String
filePath = "C:\Data\report.xlsx"
If FileExists(filePath) Then
MsgBox "ファイルが存在します: " & filePath, vbInformation
Else
MsgBox "ファイルが見つかりません: " & filePath, vbExclamation
End If
End Sub
フォルダの存在確認
Function FolderExists(folderPath As String) As Boolean
Dim attr As Long
On Error Resume Next
attr = GetAttr(folderPath)
' フォルダが存在し、かつディレクトリ属性を持つ
FolderExists = (Err.Number = 0) And ((attr And vbDirectory) = vbDirectory)
On Error GoTo 0
End Function
Sub CheckFolderExistence()
Dim folderPath As String
folderPath = "C:\Reports"
If FolderExists(folderPath) Then
MsgBox "フォルダが存在します: " & folderPath, vbInformation
Else
MsgBox "フォルダが見つかりません: " & folderPath, vbExclamation
End If
End Sub
実践的な活用例
フォルダ内のすべての Excel ファイルを開く
Sub OpenAllExcelFiles()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim fileCount As Integer
folderPath = "C:\Reports\"
fileCount = 0
' Excelファイルを検索
fileName = Dir(folderPath & "*.xlsx")
Application.ScreenUpdating = False
Do While fileName <> ""
' ファイルを開く
Set wb = Workbooks.Open(folderPath & fileName)
fileCount = fileCount + 1
Debug.Print fileCount & ": " & fileName & " を開きました"
' 何か処理...
' ファイルを閉じる
wb.Close SaveChanges:=False
' 次のファイル
fileName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox fileCount & "個のファイルを処理しました", vbInformation
End Sub
大量のファイルを処理する場合は、Application.ScreenUpdating = Falseで画面更新を停止すると、処理速度が大幅に向上します。
データ集計(複数ファイルからデータ収集)
Sub AggregateDataFromFiles()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim summaryWs As Worksheet
Dim lastRow As Long
Dim sourceLastRow As Long
folderPath = "C:\Data\"
' 集計先シートを準備
Set summaryWs = ThisWorkbook.Worksheets("集計")
lastRow = 1
' ヘッダー行
summaryWs.Cells(lastRow, 1).Value = "ファイル名"
summaryWs.Cells(lastRow, 2).Value = "データ1"
summaryWs.Cells(lastRow, 3).Value = "データ2"
lastRow = lastRow + 1
Application.ScreenUpdating = False
' Excelファイルを検索
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
' 自分自身は除外
If fileName <> ThisWorkbook.Name Then
' ファイルを開く
Set wb = Workbooks.Open(folderPath & fileName)
Set ws = wb.Worksheets(1)
' データ範囲を取得
sourceLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
' データをコピー(2行目から)
Dim i As Long
For i = 2 To sourceLastRow
summaryWs.Cells(lastRow, 1).Value = fileName
summaryWs.Cells(lastRow, 2).Value = ws.Cells(i, 1).Value
summaryWs.Cells(lastRow, 3).Value = ws.Cells(i, 2).Value
lastRow = lastRow + 1
Next i
' ファイルを閉じる
wb.Close SaveChanges:=False
End If
' 次のファイル
fileName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "データの集計が完了しました", vbInformation
End Sub
ファイル一覧を Excel シートに出力
Sub ExportFileListToSheet()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
Dim row As Long
Dim fso As Object
Dim file As Object
folderPath = "C:\Documents\"
' シートを準備
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "ファイル一覧"
' ヘッダー行
ws.Cells(1, 1).Value = "ファイル名"
ws.Cells(1, 2).Value = "拡張子"
ws.Cells(1, 3).Value = "サイズ(KB)"
ws.Cells(1, 4).Value = "更新日時"
ws.Cells(1, 5).Value = "フルパス"
row = 2
' FileSystemObjectを使用してファイル情報を取得
Set fso = CreateObject("Scripting.FileSystemObject")
fileName = Dir(folderPath & "*.*")
Do While fileName <> ""
Set file = fso.GetFile(folderPath & fileName)
ws.Cells(row, 1).Value = fileName
ws.Cells(row, 2).Value = fso.GetExtensionName(fileName)
ws.Cells(row, 3).Value = Round(file.Size / 1024, 2)
ws.Cells(row, 4).Value = file.DateLastModified
ws.Cells(row, 5).Value = file.Path
row = row + 1
fileName = Dir()
Loop
' 列幅を自動調整
ws.Columns("A:E").AutoFit
MsgBox row - 2 & "個のファイルを出力しました", vbInformation
End Sub
連番付きファイル名の生成
Function GetNextFileName(basePath As String, baseName As String, extension As String) As String
Dim counter As Integer
Dim testPath As String
counter = 1
' ファイル名が存在しない番号を探す
Do
testPath = basePath & baseName & "_" & Format(counter, "000") & extension
If Dir(testPath) = "" Then
' ファイルが存在しない
GetNextFileName = testPath
Exit Function
End If
counter = counter + 1
Loop While counter <= 999
' 999個を超えた場合
GetNextFileName = ""
End Function
Sub SaveWithNumberedName()
Dim savePath As String
savePath = GetNextFileName("C:\Backups\", "backup", ".xlsx")
If savePath <> "" Then
ActiveWorkbook.SaveAs fileName:=savePath
MsgBox "保存しました: " & savePath, vbInformation
Else
MsgBox "連番の上限に達しました", vbExclamation
End If
End Sub
古いファイルの削除
Sub DeleteOldFiles()
Dim folderPath As String
Dim fileName As String
Dim fso As Object
Dim file As Object
Dim daysOld As Integer
Dim cutoffDate As Date
Dim deleteCount As Integer
folderPath = "C:\Logs\"
daysOld = 30 ' 30日以上古いファイルを削除
cutoffDate = Date - daysOld
deleteCount = 0
Set fso = CreateObject("Scripting.FileSystemObject")
fileName = Dir(folderPath & "*.log")
Do While fileName <> ""
Set file = fso.GetFile(folderPath & fileName)
' 更新日が古いファイルを削除
If file.DateLastModified < cutoffDate Then
Debug.Print "削除: " & fileName & " (更新日: " & file.DateLastModified & ")"
' 削除前に確認(本番では削除)
' file.Delete
deleteCount = deleteCount + 1
End If
fileName = Dir()
Loop
MsgBox deleteCount & "個のファイルを削除しました", vbInformation
End Sub
ファイルの削除は取り消しできません。実装前に十分なテストを行い、本番環境では必ずバックアップを取ってから実行してください。
サブフォルダの処理(再帰処理)
Dir 関数はサブフォルダを自動で検索しません。再帰処理を使用する必要があります:
Sub SearchSubFolders()
Dim rootPath As String
rootPath = "C:\Data\"
' ルートフォルダから検索開始
Call ProcessFolder(rootPath)
End Sub
Sub ProcessFolder(folderPath As String)
Dim fileName As String
Dim subFolderName As String
' パスの末尾にバックスラッシュを追加
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
Debug.Print "=== フォルダ: " & folderPath & " ==="
' ファイルを処理
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
Debug.Print " ファイル: " & fileName
' ここでファイル処理...
fileName = Dir()
Loop
' サブフォルダを検索
subFolderName = Dir(folderPath & "*", vbDirectory)
Do While subFolderName <> ""
' "."と".."を除外
If subFolderName <> "." And subFolderName <> ".." Then
' フォルダかどうか確認
If (GetAttr(folderPath & subFolderName) And vbDirectory) = vbDirectory Then
' 再帰的にサブフォルダを処理
Call ProcessFolder(folderPath & subFolderName)
End If
End If
subFolderName = Dir()
Loop
End Sub
再帰処理は強力ですが、深い階層やシンボリックリンクがある場合、無限ループに陥る可能性があります。深さの制限を設けることを推奨します。
FileSystemObject との比較
Dir 関数の代替として、FileSystemObject(FSO)も広く使われています:
Sub CompareMethodsDir()
Dim folderPath As String
Dim fileName As String
Dim startTime As Double
folderPath = "C:\Data\"
' Dir関数を使用
startTime = Timer
fileName = Dir(folderPath & "*.*")
Do While fileName <> ""
' 処理...
fileName = Dir()
Loop
Debug.Print "Dir関数: " & Format(Timer - startTime, "0.000") & "秒"
End Sub
Sub CompareMethodsFSO()
Dim folderPath As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim startTime As Double
folderPath = "C:\Data\"
' FileSystemObjectを使用
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
startTime = Timer
For Each file In folder.Files
' 処理...
Next file
Debug.Print "FileSystemObject: " & Format(Timer - startTime, "0.000") & "秒"
End Sub
Dir 関数の利点
- シンプルで軽量
- 追加の参照設定不要
- ワイルドカードが使いやすい
- メモリ使用量が少ない
FileSystemObject の利点
- ファイルの詳細情報(サイズ、日時等)が簡単に取得可能
- サブフォルダの処理が簡単
- フォルダの作成・削除・コピーなどの操作が豊富
- コードが読みやすい
一般的に、単純なファイル一覧取得にはDir関数、複雑なファイル操作やフォルダ操作にはFileSystemObjectが適しています。
Dir 関数の制限と注意点
ネストした Dir 呼び出しの問題
Sub NestedDirProblem()
Dim fileName As String
Dim subFileName As String
' 外側のDirループ
fileName = Dir("C:\Data\*.txt")
Do While fileName <> ""
Debug.Print "外側: " & fileName
' 内側のDirループ(これは動作しない!)
subFileName = Dir("C:\SubData\*.txt")
Do While subFileName <> ""
Debug.Print " 内側: " & subFileName
subFileName = Dir() ' これが外側のループに影響する
Loop
fileName = Dir() ' 期待通りに動作しない
Loop
End Sub
Dir関数は内部状態を持つため、ネストして使用することはできません。内側のDir呼び出しが外側のDir呼び出しの状態をリセットしてしまいます。
解決策:配列に格納
Sub NestedDirSolution()
Dim fileList() As String
Dim fileName As String
Dim fileCount As Integer
Dim i As Integer
' まず配列に格納
ReDim fileList(0)
fileName = Dir("C:\Data\*.txt")
Do While fileName <> ""
ReDim Preserve fileList(fileCount)
fileList(fileCount) = fileName
fileCount = fileCount + 1
fileName = Dir()
Loop
' 配列をループ処理
For i = 0 To fileCount - 1
Debug.Print "ファイル: " & fileList(i)
' ここで別のDir呼び出しが可能
' ...
Next i
End Sub
ベストプラクティス
1. パスの末尾にバックスラッシュを確認
Function NormalizePath(path As String) As String
If Right(path, 1) <> "\" Then
NormalizePath = path & "\"
Else
NormalizePath = path
End If
End Function
Sub UsePath()
Dim folderPath As String
folderPath = NormalizePath("C:\Data")
' C:\Data\ が保証される
End Sub
2. エラー処理を含める
Sub SafeFileProcessing()
Dim folderPath As String
Dim fileName As String
On Error GoTo ErrorHandler
folderPath = "C:\Data\"
' フォルダの存在確認
If Not FolderExists(folderPath) Then
MsgBox "フォルダが見つかりません: " & folderPath, vbExclamation
Exit Sub
End If
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
Debug.Print "処理中: " & fileName
' ファイル処理...
fileName = Dir()
Loop
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub
3. 処理中にユーザーに進捗を表示
Sub ShowProgress()
Dim folderPath As String
Dim fileName As String
Dim fileCount As Integer
Dim processedCount As Integer
folderPath = "C:\Data\"
' ファイル数をカウント
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
fileCount = fileCount + 1
fileName = Dir()
Loop
' 処理実行
Application.ScreenUpdating = False
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
processedCount = processedCount + 1
' ステータスバーに進捗を表示
Application.StatusBar = "処理中: " & processedCount & " / " & fileCount & " (" & _
Format(processedCount / fileCount, "0%") & ")"
' ファイル処理...
fileName = Dir()
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "完了: " & fileCount & "個のファイルを処理しました", vbInformation
End Sub
Application.StatusBarを使用すると、長時間の処理中にユーザーに進捗を知らせることができます。
まとめ
VBA の Dir 関数について詳しく解説しました。Dir 関数はシンプルながら強力で、ファイル・フォルダ操作の基本となる関数です。
重要なポイント:
- 基本的な使い方: 最初の呼び出しでパスを指定し、以降は引数なしで次のファイルを取得
- ワイルドカード:
*と?を使ったパターンマッチング - 属性指定: vbDirectory 等でファイル属性をフィルタ
- ファイル存在確認:
Dir(filePath) <> ""で簡単に確認 - ループ処理: Do While…Loop ですべてのファイルを処理
注意事項:
- Dir 関数はネストして使用できない
- サブフォルダは自動で検索されない(再帰処理が必要)
- パスの末尾のバックスラッシュに注意
- エラー処理を忘れずに実装
使い分け:
- Dir 関数: シンプルなファイル一覧取得、パターンマッチング
- FileSystemObject: 詳細なファイル情報取得、複雑なフォルダ操作
これらの知識を活用することで、VBA でのファイル・フォルダ操作が効率的に行えるようになります。