Dir関数によるファイル操作

にメンテナンス済み

VBA でファイルやフォルダを扱う際、Dir 関数は最も基本的で重要な関数の一つです。特定のフォルダ内のファイル一覧を取得したり、ファイルの存在確認を行ったりする場合に必須の知識となります。

この記事では、Dir 関数の基本的な使い方から応用テクニック、FileSystemObject との比較まで、実践的なサンプルコードと共に詳しく解説します。

Dir 関数が必要となるシチュエーション

実務では、以下のような場面で Dir 関数を使用します:

  • 複数ファイルの一括処理: フォルダ内のすべての Excel ファイルを開いてデータ集計
  • ファイルの存在確認: 処理前に特定のファイルが存在するかチェック
  • バックアップファイルの作成: 既存ファイルがあれば連番を付けて保存
  • ログファイルの管理: 古いログファイルを削除
  • レポート生成: 特定パターンのファイルを検索して一覧作成
  • データ移行: フォルダ内のすべての CSV ファイルをインポート

Dir 関数の基本

基本構文

Dir([パス名], [属性])

Dir 関数は、指定されたパターンに一致する最初のファイルまたはフォルダ名を返します。

最もシンプルな使い方

dir_basic.bas
Sub DirBasic()
    Dim fileName As String

    ' カレントフォルダ内の最初のファイルを取得
    fileName = Dir("*.*")

    Debug.Print "最初のファイル: " & fileName
End Sub
チェック

Dir関数を初めて呼び出すときはパスを指定し、2回目以降は引数なしで呼び出すことで、次のファイルを取得できます。

ファイル一覧の取得

dir_file_list.bas
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 文字
dir_wildcards.bas
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 ファイルの一覧取得

dir_excel_files.bas
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

複数の拡張子を処理

dir_multiple_extensions.bas
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 引数で、ファイル属性を指定できます:

定数説明
vbNormal0通常のファイル(デフォルト)
vbReadOnly1読み取り専用ファイル
vbHidden2隠しファイル
vbSystem4システムファイル
vbVolume8ボリュームラベル
vbDirectory16フォルダ
vbArchive32アーカイブ属性
dir_attributes.bas
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関数で確認が必要です。

ファイルの存在確認

dir_file_exists.bas
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

フォルダの存在確認

dir_folder_exists.bas
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 ファイルを開く

dir_open_all_excel.bas
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で画面更新を停止すると、処理速度が大幅に向上します。

データ集計(複数ファイルからデータ収集)

dir_data_aggregation.bas
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 シートに出力

dir_export_to_sheet.bas
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

連番付きファイル名の生成

dir_generate_numbered_filename.bas
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

古いファイルの削除

dir_delete_old_files.bas
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 関数はサブフォルダを自動で検索しません。再帰処理を使用する必要があります:

dir_recursive.bas
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)も広く使われています:

dir_vs_fso.bas
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 呼び出しの問題

dir_nested_problem.bas
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呼び出しの状態をリセットしてしまいます。

解決策:配列に格納

dir_nested_solution.bas
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. パスの末尾にバックスラッシュを確認

best_practice_path.bas
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. エラー処理を含める

best_practice_error_handling.bas
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. 処理中にユーザーに進捗を表示

best_practice_progress.bas
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 関数はシンプルながら強力で、ファイル・フォルダ操作の基本となる関数です。

重要なポイント

  1. 基本的な使い方: 最初の呼び出しでパスを指定し、以降は引数なしで次のファイルを取得
  2. ワイルドカード: *?を使ったパターンマッチング
  3. 属性指定: vbDirectory 等でファイル属性をフィルタ
  4. ファイル存在確認: Dir(filePath) <> ""で簡単に確認
  5. ループ処理: Do While…Loop ですべてのファイルを処理

注意事項

  • Dir 関数はネストして使用できない
  • サブフォルダは自動で検索されない(再帰処理が必要)
  • パスの末尾のバックスラッシュに注意
  • エラー処理を忘れずに実装

使い分け

  • Dir 関数: シンプルなファイル一覧取得、パターンマッチング
  • FileSystemObject: 詳細なファイル情報取得、複雑なフォルダ操作

これらの知識を活用することで、VBA でのファイル・フォルダ操作が効率的に行えるようになります。

#VBA #Dir関数 #ファイル操作 #フォルダ操作 #FileSystemObject