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

解決済

質問者：djtriple
質問日時：2021/10/23 14:04
回答数：2件

エクセルで画像が入った親フォルダ名とそのフォルダ内にある画像ファイルを一覧表を作りたいです。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

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (2件)

参考程度に

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