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

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

https://drive.google.com/file/d/11qEUTsq87UItzoKu2okX5WgEopRercCb/view?usp=drive_link

今回ご紹介するプロシージャは
| プロシージャ名		| 概要						|
|-------------------------------|-----------------------------------------------|
| 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シリーズ記事一覧
もしよろしければ他の記事もご覧ください！

https://qiita.com/Reko/items/3e482f9a73353e964f00

https://qiita.com/Reko/items/af042ae33cdc01e1dc96

https://qiita.com/Reko/items/9e211c9c496e12283f33

https://qiita.com/Reko/items/c2dab7b0e8207f8049df

https://qiita.com/Reko/items/b5abcdf614cef5d4073a

https://qiita.com/Reko/items/3451339e723a34ac7897

https://qiita.com/Reko/items/0269b2bece07a675e797

https://qiita.com/Reko/items/e2d0d0bf2dea4feface1

https://qiita.com/Reko/items/b995c3da88d25f6e0104

https://qiita.com/Reko/items/bc97d79599cfd431b2f3

https://qiita.com/Reko/items/1731aaddfc6e50c209df

https://qiita.com/Reko/items/554a47f2aa944e2eec5e

https://qiita.com/Reko/items/e8253ac68ccafba44ad3