| 
    
     |  | MIKA さん IROC さん こんにちは、 
 Sheet1 の A列にフォルダAのファイル名、B列に対応するフォルダBのファイル名が出力されるように作ってみました。
 AにあってBに無いものはB列は空白
 Aになくて、Bにあるものは出力されません。
 
 FileDialog は Office XP 以降が必要です。
 そうでない場合は、別の手段でフォルダ名を設定してください。
 
 '以下コード
 Option Explicit
 
 Sub ファイル名抽出マクロ()
 
 Const myFileNameA As String = "*200501.xls"
 Const myFileNameB As String = "ABC*.xls"
 Dim myFolderA  As String
 Dim myFolderB  As String
 Dim FnA     As String
 Dim FnB     As String
 Dim KENMEI   As String
 Dim myShell   As Variant
 Dim ret     As Variant
 Dim iFn     As Variant
 Dim rgOut    As Range
 Dim buf(1 To 1, 1 To 2) As Variant
 
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Title = "フォルダA"
 .ButtonName = "選択"
 ret = .Show
 If ret = 0 Then Exit Sub
 myFolderA = .SelectedItems(1)
 End With
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Title = "フォルダB"
 .ButtonName = "選択"
 ret = .Show
 If ret = 0 Then Exit Sub
 myFolderB = .SelectedItems(1)
 End With
 
 '  myFolderA = "フォルダAのパス"
 '  myFolderB = "フォルダBのパス"
 
 With Application.FileSearch
 .LookIn = myFolderA
 .SearchSubFolders = False
 .Filename = myFileNameA
 .Execute
 End With
 
 Set rgOut = ThisWorkbook.Worksheets("Sheet1").Range("A1:B1")
 
 For Each iFn In Application.FileSearch.FoundFiles
 FnA = Dir(iFn)
 KENMEI = Left(FnA, Len(FnA) - 10)
 FnB = WorksheetFunction.Substitute(myFileNameB, "*", KENMEI)
 FnB = Dir(myFolderB & Application.PathSeparator & FnB)
 buf(1, 1) = FnA
 buf(1, 2) = FnB
 rgOut = buf
 Set rgOut = rgOut.Offset(1, 0)
 
 'ここで、FnA,FnBを利用して、処理を記入する。
 
 Next iFn
 End Sub
 
 |  |