VBA フォルダ名と画像ファイル名取得

エクセルで画像が入った親フォルダ名とそのフォルダ内にある画像ファイルを一覧表を作りたいです。Sheet2のP1には親フォルダのパス名。P2には親フォルダ名。3行目以降の行には親フォルダ内にあるフォルダ名を転記。Sheet2はSheet2という名前でなく２番目としています。
Sheet2のQ2には親フォルダにあるフォルダに入っていない画像ファイル名を。それQ列以降の各列には各フォルダ内にある画像ファイル名を転記したいです。調べながらやりましたが、サブフォルダ名は転記できましたが、親フォルダ名と画像名が転記できません。どうすればいいでしょうか？
Private Sub CommandButton3_Click()
Dim targ As String
targ = "C:\Users\user\Pictures\〇〇"

Dim i As Integer
Dim FILE_PATH As String
Dim FSO As Object
Dim TARGET As Object
Dim TEMP As Object

FILE_PATH = targ

'ヘッダーの作成
Sheet2.Range("P1") = FILE_PATH

'3行目からフォルダ名を記載
i = 3

Set FSO = CreateObject("Scripting.FileSystemObject")
Set TARGET = FSO.GetFolder(FILE_PATH).SubFolders

For Each TEMP In TARGET
Sheet2.Cells(i, "P") = TEMP.Name
i = i + 1
Next

'画像ファイル一覧"
Dim buf As String
For i = 2 To 50
buf = Dir(Sheet2.Range("P1") & "\" & Sheet2.Cells(i, "P"))
Next
j = 2
Do While buf <> ""

buf = Dir()

Sheet2.Cells(j, j + 15).Value = buf
j = j + 1
Loop
End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2021/10/27 12:37

こんにちは

”.jpg”で取得できないのは＊が付いていない為ではないかと、
すべてのファイルを対象に
buf = Dir(FILE_PATH & "\*")

buf = Dir(FILE_PATH & "\" & subfol & "\*")
ではどうでしょう？
また、取得したい拡張子を調べてくださいね

この回答へのお礼

ありがとうございます。ご指摘通りにできました。大変に助かりました。

お礼日時：2021/10/27 13:00

No.1 回答者： Qchan1962 回答日時： 2021/10/23 19:19

こんばんは、

なさりたい事が分からずですが、ファイル名を取得する方法などを
お示しのコードを参考に書いてみました。（纏めず分けています）
新規ブックで確認してみてください。参考になるかも知れませんが
ならないかも知れません。
ファイルを取得する為、暫定pngファイルとしました。
すべてのファイルを取得する場合は、*.*で対応します。

Dim targ As String
targ = "C:\Users\user\Pictures\〇〇"
Dim i As Integer, j As Integer, n As Long
Dim FILE_PATH As String
Dim FSO As Object
Dim TARGET As Object
Dim TEMP As Object
Dim subfol As Range
Dim buf As String

FILE_PATH = targ

Set FSO = CreateObject("Scripting.FileSystemObject")
Set TARGET = FSO.GetFolder(FILE_PATH).SubFolders

'ヘッダーの作成
Sheet2.Range("P1") = FILE_PATH
'3行目からフォルダ名を記載
n = 3
For Each TEMP In TARGET
Sheet2.Cells(n, "P") = TEMP.Name
n = n + 1
Next

'親フォルダ内画像ファイル一覧"
j = 17 'Q
n = 2 '2行目にフォルダパス
Cells(n, j) = FILE_PATH
buf = Dir(FILE_PATH & "\*.png")
Do While buf <> ""
n = n + 1
Cells(n, j) = buf
buf = Dir()
Loop
' サブフォルダ内画像ファイル一覧
j = j + 1 '列の移動
For Each subfol In Range("P3", Cells(Rows.Count, "P").End(xlUp))
n = 2
Cells(n, j) = FILE_PATH & "\" & subfol
buf = Dir(FILE_PATH & "\" & subfol & "\*.png")
Do While buf <> ""
n = n + 1
Cells(n, j) = buf
buf = Dir()
Loop
j = j + 1
Next

この回答へのお礼

遅くなりました。ご回答ありがとうございます。
フォルダ名は転記できたのですが各フォルダ内にある画像ファイル名を転記ができないです。"\*.png"を"."にしたり、”.jpg”にしたりしたんですができませんでした。

お礼日時：2021/10/24 11:31