エクセルのマクロについて教えてください。

下記のマクロを実行すると指定フォルダ内にワイルドカードで指定した
フォルダの有無を検索し、メッセージが表示されます。
このマクロを
ワイルドカードの数字の部分を
例えば「12345678-6_」
マクロを設定しているブックのシート名「番号」のセル値「C1：C6」に記載のある番号
に変更して該当フォルダの有無を検索できるように変更する方法を教えてください。
該当フォルダが複数あり場合は、メッセージボックスにその旨を表示出来るようにしたいのですが、
よろしくお願いいたします。
一つの例ですが
画像のパターンですと
メッセージボックスに「12345678-6_北海　太郎」と「123456789-1_北海　花子」の2つを表示です。
マクロ
Sub フォルダ検索()
Dim 検索フォルダパス As String
検索フォルダパス = "C:\Users\160931\Desktop\10月16日\テスト"

Dim 該当フォルダパス As String
Dim dir結果値 As String
dir結果値 = Dir(検索フォルダパス & "\12345678-6_*", vbDirectory)
Do While dir結果値 <> ""

Dim dir結果パス As String
dir結果パス = 検索フォルダパス & "\" & dir結果値

If GetAttr(dir結果パス) And vbDirectory Then
該当フォルダパス = dir結果パス
Exit Do
End If

dir結果値 = Dir()
Loop

If 該当フォルダパス <> "" Then
MsgBox "該当フォルダのパス：" & 該当フォルダパス
End If

End Sub
以上となります。
よろしくお願いいたします。

質問者からの補足コメント

• 

  おはようございます。
  詳しいコードをありがとうございました。
  一つお願いがあります。
  教えて頂いた、貴者のコードを実行すると
  メッセージボックスに
  該当フォルダパスが全て表示されますが、
  出来れば、C:￥～テスト￥までを省いて、「12345678-6_北海　太郎」「123456789-1_北海　花子」のみをメッセージボックスに表示出来る方法はありますでしょうか。
  何度も申し訳ありません。
  よろしくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/10/20 08:53

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2023/10/20 15:00

>「123456789-1_北海　花子」のみをメッセージボックスに表示出来る方法はありますでしょうか。

SubFoldersのSubFolder代入している　fol As Object　のNameプロパティでフォルダ名が取得できます

該当変更箇所
After

If AnsMsg = "" Then
AnsMsg = fol.Name
Else
AnsMsg = AnsMsg & vbCrLf & fol.Name
End If

この回答へのお礼

色々とありがとうございました

お礼日時：2023/10/20 21:39

No.1 回答者： Qchan1962 回答日時： 2023/10/19 18:20

ワイルドカードで検索との事で　該当するすべてで良いのでしょうか

フォルダの検索・・・Dirでも良いですが　先の質問で使用されていた
Scripting.FileSystemObjectのGetFolder(検索フォルダパス).SubFoldersを使用して　一例です
Sub フォルダ検索()
Dim 検索フォルダパス As String
検索フォルダパス = "C:\Users\160931\Desktop\10月16日\テスト"

Dim AnsMsg As String
Dim rng As Range
Set rng = Range("C1:C6")

Dim fso As Object, fol As Object
Set fso = CreateObject("Scripting.FileSystemObject")

For Each r In rng
If r.Value <> "" Then
For Each fol In fso.GetFolder(検索フォルダパス).SubFolders
If fol Like 検索フォルダパス & "\" & r.Value & "*" Then
If AnsMsg = "" Then
AnsMsg = fol
Else
AnsMsg = AnsMsg & vbCrLf & fol
End If
End If
Next
End If
Next


If AnsMsg <> "" Then
MsgBox "該当フォルダのパス：" & vbCrLf & AnsMsg
End If

End Sub

この回答へのお礼

回答ありがとうございます　何時も助けて頂き感謝いたします
早速試してみます
又　連絡させて頂きます

お礼日時：2023/10/19 18:23