| |
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
|
|
G-Luck
- 05/3/9(水) 16:53 -
