EXCEL VBA サブフォルダを含めて検索する

'
' フォルダ検索を行います。指定の文字が入った一番初めのフォルダ名を戻します。(サブフォルダは一段目まで)
'
'フォルダが見つからない場合は、空の文字列
'
'引数
'　pbln部分一致  　TRUE pstr検索フォルダ名とフォルダ名が部分一致(INSTRで含む)
'　            　　FALSE pstr検索フォルダ名とフォルダ名が完全一致
Function strフォルダ名を取得(ByVal pstr検索フォルダ名 As String, ByVal pstr検索場所 As String, Optional pbln部分一致 As Boolean = False) As String
    Dim FSO
    Dim strTemp As String
    Dim strTemp2 As String
    Dim intTemp2 As Integer
    Dim subfolder

    Set FSO = CreateObject("Scripting.FileSystemObject")
    intTemp2 = InStrRev(pstr検索場所, "\")
    strTemp2 = Mid(pstr検索場所, intTemp2 + 1)
    If pbln部分一致 = True Then
        If InStr(strTemp2, pstr検索フォルダ名) > 0 Then
             strフォルダ名を取得 = pstr検索場所
             Exit Function
        End If
    Else
        If strTemp2 = pstr検索フォルダ名 Then
             strフォルダ名を取得 = pstr検索場所
             Exit Function
        End If
    End If
    
    
    'フォルダ内のサブフォルダをループ
    For Each subfolder In FSO.GetFolder(pstr検索場所).SubFolders
        '再帰する
        strTemp = strフォルダ名を取得(pstr検索フォルダ名, subfolder, pbln部分一致)
        If strTemp = "" Then
        Else
            strフォルダ名を取得 = strTemp
            Exit Function
        End If
    Next
End Function