| 
    
     |  | 私のPCにその圧縮フォルダを解凍するものがなかったようで、 かみちゃんさんに載せていただいたコードを、ご指導のように、
 変更すると期待しているものができました。
 
 ひとつ要望とすれば、
 ファイルを記入した際、
 例)C:\\ファイル名
 例)C:\ファイル名\AlbumArtSmall.jpg.files
 
 のように拾ってくるのですが、これを
 ファイル名だけ。という風に変更するにはどう変更すればいいのでしょうか。
 
 
 Option Explicit
 Public cnt, Pop As Integer
 
 Sub test3()
 
 Dim FolderSpec As String
 
 FolderSpec = FolderPath
 
 cnt = 1
 Pop = 1
 
 If FolderSpec <> "" Then
 ListUp FolderSpec
 End If
 
 End Sub
 Sub ListUp(FolderSpec)
 
 Dim File_Collection As Object
 Dim File_List As Variant
 Dim Folder_Collection As Object
 Dim Folder_List As Variant
 
 Set File_Collection = CreateObject("Scripting.FileSystemObject").GetFolder(FolderSpec).Files
 
 'Foldor の名前をセルに入力
 Cells(cnt, Pop) = FolderSpec
 cnt = cnt + 1
 
 Set Folder_Collection = CreateObject("Scripting.FileSystemObject").GetFolder(FolderSpec).SubFolders
 
 For Each Folder_List In Folder_Collection
 ListUp FolderSpec & "\" & Folder_List.Name
 Next
 End Sub
 
 Function FolderPath() As String
 
 Dim Shell As Object
 
 Set Shell = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0, "")
 
 
 If Shell Is Nothing Then
 FolderPath = ""
 Else
 FolderPath = Shell.Items.Item.Path
 End If
 
 End Function
 
 
 |  |