1
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

VBAで特定のフォルダ以下のファイルを全て取得する関数(正規表現によるフィルター対応)

Last updated at Posted at 2020-01-12

.NETのDirectory.GetFilesとか Directory.EnumerateFilesにあたる機能がほしかったのですが無かったみたいなので忘却録のような形で。
FileSystemObjectのFileオブジェクトを取得するため、フルパス、名前だけ、更新日時など簡単に出力時に切り替えられるかと。

以下を任意モジュールに以下をコピーして下さい。

Private Filedic As Object 'Dictionary , 参照:Microsoft Scripting Runtime
Private Reg As Object 'RegExp , 参照:Microsoft VBScript Regular Expressions 5.5

Public Function GetFilesForAllDirectories(currentFolder As String, Optional regPattern As String = ".*", Optional regIgnoreCase As Boolean = False) As Variant

    Set Filedic = CreateObject("scripting.dictionary") 'New Dictionary(Microsoft Scripting Runtimeが有効な場合)
    Set Reg = CreateObject("VBScript.RegExp") 'New RegExp(Microsoft VBScript Regular Expressions 5.5が有効な場合)
    Reg.Pattern = regPattern
    Reg.IgnoreCase = regIgnoreCase 'デフォルトはTrueです。True=大文字小文字を区別しない、False=区別する
   
    Call GetFilePath(currentFolder)
    GetFilesForAllDirectories = Filedic.Keys

End Function

Private Function GetFilePath(folderPath As String) as Variant

    Dim fso As Object: Set fso = CreateObject("scripting.Filesystemobject") ' New FileSystemObject (Microsoft Scripting Runtimeが有効な場合)
    Dim subfolder As Object 'Folder(Microsoft Scripting Runtimeが有効な場合)
   
    For Each subfolder In fso.GetFolder(folderPath).SubFolders
        Call GetFilePath(subfolder.Path)
    Next
   
    Dim file 'as Fileとしたいですが for eachで帰ってくる要素はVariant限定なのでas Fileはデバッグ以外で使用できません
    For Each file In fso.GetFolder(folderPath).Files
        If Reg.test(file.Path) Then
            Filedic.Add file, 0
        End If
    Next
   
End Function

使い方
regPatternを指定しなかった場合は全てのファイルを取得します。
以下では、xls/xlsx/xlsm/xlsmなどのexcelファイルを取得しています。

Sub PrintGetFilesTest()

    Dim currentFolder As String: currentFolder = "C:\hogehoge\"
    Dim regPattern As String: regPattern = ".*\.xls.?$"
   
    Dim files:files = GetFilesForAllDirectories(currentFolder, regPattern, True)
    Dim file 

    For Each file In files
        Debug.Print file.Path 
        'ファイルオブジェクトを取得しているため
        'file.Pathだとフルパスを、file.Nameだとファイル名だけを、file.DateLastModifiedだと更新日時を取得できます。
        'ex .Attributes→拡張子 .DateCreated→ファイル作成日 .DateLastAccessed→最終アクセス日 .Size→ファイルサイズ
    Next
End Sub
1
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?