| |
▼かみちゃん さん：
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
このコードを実行したところ、希望の内容に近いのですが
1.フォルダ名を抜き出したいフォルダ（A）を選択する
2.そのフォルダ（A)の中にあるフォルダ（A-A’)の名前を抽出する
3.抽出したフォルダ名（A-A')をシートに記入していく
という内容なのですが、
1.はできました
2.は、A-A'のさらに中にあるフォルダまで引っ張ってきてしまいます。
必要なのは、A-A'のフォルダ名だけなのですが、
どう変更したらいいのでしょうか。
|
|
初心者
- 10/1/30(土) 15:49 -
