指定したフォルダのサブフォルダも含めて保存されている全てのファイルのファイル名を取得してExcelのセルに書き込むVBAのサンプルプログラムを覚書。

Office 2007以降はFileSearchオブジェクトが使用できなくなったため、代わりに"FileSystemObject"を再帰呼び出しする方法を使います。

Excelで使う時のが多いかなと思って以前書いたAccessのVBAの記事「Access VBA:指定したフォルダのサブフォルダも含めてファイル名の一覧を取得してテーブルに追加するVBAのサンプルプログラム」のサンプルプログラムをExcel VBAに書きなおしました。
スポンサードリンク


サンプルプログラム概要

この記事では3つのサンプルプログラムを紹介します。
  1. 取得したファイル名の一覧をセルにフルパスで書き出すサンプルプログラム

  2. 取得したファイル名の一覧をパスとファイル名に分けて2つのセルに書き出すサンプルプログラム

  3. 取得したファイル名の一覧をパスの区切りである"\"マークを区切り文字として分けてから各セルに書き出すサンプルプログラム

3番めのサンプルプログラムについてですが、例えば"C:\Folder1\SubFolder2\File.txt"というファイルがあった場合、セルには\マークを区切りに"C:","Folder1"、"Folder2"、"File.txt"の4つに分解されて各セルに書き出されます。

取得したファイル名の一覧をセルにフルパスで書き出すサンプルプログラム

以下に指定したフォルダのサブフォルダも含めて保存されているファイル名の一覧を取得してフルパスでセルに書き出すサンプルプログラムを記載します。

再帰呼び出しを行うため、別のプログラムから呼び出して使用する方法になっています。

サンプルプログラム本体
Sub GetFileList01(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object

'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False

Set objFs = CreateObject("Scripting.FileSystemObject")

    'パスの取得
    For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
        'サブフォルダまで検索するために再帰実行
        GetFileList01 objFolders.Path
    Next
     
    'ファイル名の取得
    For Each objFiles In objFs.GetFolder(Search_Path).Files
        'セルにファイル名を書き込む
        ActiveCell.Value = objFiles.Path
        ActiveCell.Offset(1, 0).Select
    Next
    
End Sub

実際にサンプルプログラムを動作させる際はこちらを実行します。
Sub Call_GetFileList()    
    Worksheets("Sheet1").Range("a1").Select
    
    GetFileList01 "C:\Program Files"
End Sub

上記サンプルでは、例として"C:\Program Files"フォルダを指定しています。

取得したファイル名の一覧をパスとファイル名に分けて2つのセルに書き出すサンプルプログラム

以下にファイル名とパスを別々のセルに書き出すサンプルプログラムを記載します。

同様に実行時は別のプログラムから呼び出して実行します。

サンプルプログラム本体
Sub GetFileList02(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
Dim File_Path As String, File_Name As String
Dim Start_No As Integer

'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False

Set objFs = CreateObject("Scripting.FileSystemObject")

    'パスの取得
    For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
        'サブフォルダまで検索するために再帰実行
        GetFileList02 objFolders.Path
    Next
     
    'ファイル名の取得
    For Each objFiles In objFs.GetFolder(Search_Path).Files
        Start_No = InStrRev(objFiles.Path, "\") + 1
        
        File_Name = Right(objFiles.Path, Len(objFiles.Path) - Start_No)
        File_Path = Left(objFiles.Path, Start_No - 1)
        
        'セルにパスとファイル名を書き込む
        ActiveCell.Value = File_Path
        ActiveCell.Offset(0, 1).Value = File_Name
        ActiveCell.Offset(1, 0).Select
        
    Next
    
End Sub

実際にサンプルプログラムを動作させるプログラム。
Sub Call_GetFileList()

    GetFileList02 "C:\Program Files"
    
End Sub

取得したファイル名の一覧をパスの区切りである"\"マークを区切り文字として分けてから各セルに書き出すサンプルプログラム

以下にフルパスを"\"マークを区切り文字として分解し、分解された各値を別々のセルに書き出すサンプルプログラムを記載します。

実行時は別のプログラムから呼び出して実行します。

サンプルプログラム本体
Sub GetFileList03(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
Dim File_Path As String, File_Name As String
Dim i As Long, arrData

'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False

Set objFs = CreateObject("Scripting.FileSystemObject")

    'パスの取得
    For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
        'サブフォルダまで検索するために再帰実行
        GetFileList03 objFolders.Path
    Next
     
    'ファイル名の取得
    For Each objFiles In objFs.GetFolder(Search_Path).Files
        '\マークを区切り文字として各文字列を配列に代入
        arrData = Split(objFiles.Path, "\")
        
        'セルに配列の各値を書き込む
        For i = 0 To UBound(arrData)
            ActiveCell.Offset(0, i).Value = arrData(i)
        Next i
        
        ActiveCell.Offset(1, 0).Select
        
    Next
    
End Sub

実際にサンプルプログラムを動作させるプログラム。
Sub Call_GetFileList()

    GetFileList03 "C:\Program Files"
    
End Sub

サブフォルダも含めて指定したフォルダのファイル名一覧をセルに書き出すするサンプルプログラムまとめ

別の記事で紹介したAccessのVBAで作ったプログラムをExcelのVBA用にプログラムを書き換えました。

Accessで行う場合はこちらの記事を参照してください。

スポンサードリンク

  

関連記事