色彩を教える人になるための講座「色彩講師養成講座」の魅力とは>>

エクセルで画像が入った親フォルダ名とそのフォルダ内にある画像ファイルを一覧表を作りたいです。Sheet2のP1には親フォルダのパス名。P2には親フォルダ名。3行目以降の行には親フォルダ内にあるフォルダ名を転記。Sheet2はSheet2という名前でなく2番目としています。
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

gooドクター

A 回答 (2件)

こんにちは


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

buf = Dir(FILE_PATH & "\" & subfol & "\*")
ではどうでしょう?
また、取得したい拡張子を調べてくださいね
    • good
    • 0
この回答へのお礼

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

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

こんばんは、


なさりたい事が分からずですが、ファイル名を取得する方法などを
お示しのコードを参考に書いてみました。(纏めず分けています)
新規ブックで確認してみてください。参考になるかも知れませんが
ならないかも知れません。
ファイルを取得する為、暫定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
    • good
    • 0
この回答へのお礼

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング