第6回 直感！スグに使える業務向けVBA汎用プロシージャ(パス取得)

第0回で配布しました汎用プロシージャのコードの紹介と簡単な解説をやっていきたいと思います！
以下のリンクから .bas ファイルをダウンロードできます（zipファイル）

今回ご紹介するプロシージャは

プロシージャ名	概要
GetFolderPath	フォルダの絶対パスを取得
GetFilePath	ファイルの絶対パスを取得
GetFilePaths	複数ファイルの絶対パスを取得
GetItemPaths	指定フォルダ内のすべてのファイルの絶対パスを取得

第5回にてご紹介したOpenFolderとOpenFileとぜひ組み合わせたいプロシージャたちになります！

GetFolderPath

Function GetFolderPath() As String
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜フォルダ選択ダイアログから絶対パスを取得
'------------------------------------------------------------------------------------------------------------------------------
'　引数　　｜なし
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜String型 - 選択したフォルダの絶対パス
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    With Application.fileDialog(msoFileDialogFolderPicker)
        If .Show <> -1 Then Exit Function
        GetFolderPath = .SelectedItems(1)
    End With
    
End Function

フォルダのみが表示されるダイアログボックスが開き、選択したフォルダの絶対パスを取得します。個人的によく使う処理なのですが、毎回書くの面倒ですからね...汎用プロシージャにしちゃいました(笑)

GetFilePath

Function GetFilePath(Optional fileFilter As String = "") As String
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜ファイル選択ダイアログから絶対パスを取得
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜fileFilter - 拡張子文字列(例:"xls"や"csv")(String型)
'　　　　　｜※拡張子のみ指定可、自動で*.xxxに補完
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜String型 - 選択されたファイルの絶対パス
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    With Application.fileDialog(msoFileDialogFilePicker)
        .Filters.Clear 'フィルターの初期化
        ' フィルター処理
        If fileFilter <> "" Then
            ' 拡張子を指定した場合
            If InStr(fileFilter, ",") = 0 Then
                .Filters.Add UCase(fileFilter) & "ファイル", "*." & fileFilter
            End If
        End If
        
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1)
    End With
    
End Function

こちらもダイアログボックスが開きファイルを選択することで、そのファイルの絶対パスを取得することができます。また引数に"xls"や"csv"など拡張子をしてしていただくとファイルフィルターが適用されます。

GetFilePaths

Function GetFilePaths(Optional fileFilter As String = "") As Variant
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜ファイル選択ダイアログから複数ファイルの絶対パスを取得
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜fileFilter - 拡張子文字列(例:"xls"や"csv")(String型)
'　　　　　｜※拡張子のみ指定可、自動で*.xxxに補完
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜Variant型 - 選択されたファイルの絶対パス(1次元配列:インデックスは1開始)
'　　　　　｜※キャンセル時は空の配列
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim arrSize         As Long 'インデックス番号
    Dim filePathList()  As String '絶対パス格納用配列
    Dim fileDialog      As fileDialog
    
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    
    With fileDialog
        .AllowMultiSelect = True 'ファイルの複数選択を許可
        .Filters.Clear 'フィルターの初期化
        'フィルター処理
        If fileFilter <> "" Then
            If InStr(fileFilter, ",") = 0 Then
                .Filters.Add UCase(fileFilter) & "ファイル", "*." & fileFilter
            End If
        End If
        'キャンセル時
        If .Show <> -1 Then
            ReDim filePathList(0)
            GetFilePaths = filePathList
            Exit Function
        End If
        '何も選択しなかったとき
        If .SelectedItems.Count = 0 Then
            ReDim filePathList(0)
            GetFilePaths = filePathList
            Exit Function
        End If
        
        '選択したファイルの絶対パスを配列に格納
        ReDim filePathList(1 To .SelectedItems.Count)
        For arrSize = 1 To .SelectedItems.Count
            filePathList(arrSize) = .SelectedItems(arrSize)
        Next arrSize
    End With
    
    GetFilePaths = filePathList
    
End Function

上のGetFilePathでは一つのファイルの絶対パスを取得するのに対し、こちらは複数のファイルが選択でき、それらの絶対パスを配列として取得できます。(恥ずかしながらこれ最近知りました...)

戻り値が配列のメリットとして、パス取得の後for文と組み合わせることによって選択したファイルたちに対して処理が行える点にあります。簡単に使用例を示すと...

Sub Main()
    
    Dim i As Long
    Dim A As Variant
    
    A = GetFilePaths("xlsx") '.xlsxファイルを選択
    
    For i = 1 To UBound(A)
        Workbooks.Open (A(i))
        
        '開いたブックに対して行いたい処理
        
        ActiveWorkbook.Close
    Next i
    
End Sub

このような感じになります。.xlsxファイルを選択して配列Aに格納、ひとつづつブックを開いて何かしらの処理をしてからそのブックを閉じるを繰り返すといった内容になっております。このようなコードを書くことで例えば大量のExcelファイルの更新やデータ集計などが自動化できてしまいます！

GetItemPaths

Function GetItemPaths(folderPath As String, Optional itemFilter As String = "") As Variant
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜指定フォルダ内のファイル/フォルダの絶対パスを取得(拡張子・フォルダ選択可)
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜folderPath - 対象フォルダの絶対パス(String型)
'　引数２　｜itemFilter - "f"でフォルダ、拡張子指定でファイル、空で全取得(String型)
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜Variant型 - フォルダ内にあるファイル/フォルダの絶対パス(1次元配列：インデックスは1開始)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'　　　　　｜Ver.1.0.1(2025/04/28:itemListへの代入の式を修正)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim arrSize         As Long 'インデックス番号
    Dim itemPathList()  As String '絶対パス格納用配列
    Dim itemPath        As String '処理ファイル/フォルダ
    Dim fullPath        As String '処理フォルダ絶対パス

    arrSize = 1

    If itemFilter = "f" Then
        'フォルダのみ抽出
        itemPath = Dir(folderPath & "\*", vbDirectory)
        Do While itemPath <> ""
            If itemPath <> "." And itemPath <> ".." Then
                fullPath = folderPath & "\" & itemPath
                If (GetAttr(fullPath) And vbDirectory) = vbDirectory Then
                    ReDim Preserve itemPathList(arrSize)
                    itemPathList(arrSize) = folderPath & "\" & itemPath
                    arrSize = arrSize + 1
                End If
            End If
            itemPath = Dir()
        Loop
    Else
        'ファイル抽出(拡張子フィルタあり)
        If itemFilter <> "" Then itemFilter = "*." & itemFilter
        itemPath = Dir(folderPath & "\" & itemFilter)
        Do While itemPath <> ""
            ReDim Preserve itemPathList(arrSize)
            itemPathList(arrSize) = folderPath & "\" & itemPath
            arrSize = arrSize + 1
            itemPath = Dir()
        Loop
    End If

    ' 該当なしの場合空配列を返す
    If arrSize = 1 Then ReDim itemPathList(0)

    GetItemPaths = itemPathList

End Function

【修正】フォルダ内のデータの絶対パス取得のつもりが名前のみの取得になってしまっていたため修正いたしました(Ver.1.0.0 → Ver.1.0.1)

上3つのプロシージャはダイアログボックスが開いておりましたが、このプロシージャはダイアログボックスが開かず、対象のフォルダの絶対パスを渡すことで動作します。ですのでGetFolderPathとの連携がほぼほぼ前提となっております。例を挙げると...

Sub Main()
    
    Dim Path As String
    Dim A As Variant
    
    Path = GetFolderPath()
    A = GetItemPaths(Path)
    
    Call PasteArray(A, 1, 1, 1)
    
End Sub

このようなコードであればダイアログボックスで選択したフォルダ内のファイルの絶対パスの一覧がA1セル起点に縦に作られます。

ぜひこれらを活用してデータの処理を自動化しちゃいましょう！

直感！VBAシリーズ記事一覧

もしよろしければ他の記事もご覧ください！