Exelマクロで指定フォルダ内の中身を

質問

Exel VBA 初心者です。

指定したフォルダに入っているフォルダの名前を、Exelマクロで書き出すようにしたいのですが、
どうしたらいいでしょうか。

マイドキュメント\業務ファイル

この「業務ファイル」というフォルダの中身を整理するために、
フォルダ名の一覧をExelのシートに書き出したいのです。

以前、指定フォルダ内のファイル名を書き出すマクロを作ったことがあります。
これを改造すればできますか？
このマクロでは、B1セルにパスを入れるようにしてあります。

――――――――――――――――――――――――
Sub ファイル名一覧作成()

Dim フォルダ As String
Dim ファイル名 As String
Dim 行 As Long

フォルダ = Cells(1, 2).Value & "\"
ファイル名 = Dir(フォルダ & "*.*")
Cells(4, 1).Value = ファイル名

行 = 4
Do Until ファイル名 = ""
Cells(行, 1).Value = ファイル名
行 = 行 + 1
ファイル名 = Dir()
Loop

End Sub
――――――――――――――――――――――――

環境：WindowsXP、Exel2003

回答No.3

KenKen_SP · ベストアンサー

' // Sample1::　元のコードを生かした場合
Sub フォルダ名一覧作成()

　　’// #2 とほとんど同じですね...サブフォルダの列挙なので
　　’// 検索のルートとなるフォルダは含めないようにしてます

　　Dim フォルダ　　 As String
　　Dim フォルダ名　 As String
　　Dim 行　　　　　 As Long
　　フォルダ = Cells(1, 2).Value & "\"
　　フォルダ名 = Dir$(フォルダ, vbDirectory)
　　行 = 4
　　Do Until Len(フォルダ名) = 0
　　　　If フォルダ名 <> "." And フォルダ名 <> ".." Then
　　　　　　If GetAttr(フォルダ & フォルダ名) And vbDirectory Then
　　　　　　　　Cells(行, 1).Value = フォルダ名
　　　　　　　　行 = 行 + 1
　　　　　　End If
　　　　End If
　　　　フォルダ名 = Dir$()
　　Loop
End Sub

' // 以下の方法もあります

' // Sample2::　File System Object を使った例
Sub EnumSubfolders()
　　Dim fso　　　　As Object
　　Dim RootFolder As Object
　　Dim F　　　　　As Object
　　Dim r　　　　　As Long

　　Set RootFolder = CreateObject("Shell.Application"). _
　　　　　　　　　　 BrowseForFolder(0, "Select Folder", &H1)
　　If RootFolder Is Nothing Then Exit Sub

　　Set fso = CreateObject("Scripting.FileSystemObject")
　　r = 4
　　For Each F In fso.GetFolder(RootFolder.Self.Path).SubFolders
　　　 Cells(r, 1).Value = F.Name
　　　 r = r + 1
　　Next
　　Set RootFolder = Nothing
　　Set fso = Nothing
End Sub

お礼

ありがとうございます！
早速試してみました。
この方法だとルートフォルダは除外されるわけですね。
で、コンマが出てこないということでしょうか。

Sample2ではフォルダの指定ができるのですね！
意図を汲み取って提案してくださってありがとうございます。
初心者の私には一見で理解できるものではありませんが、
じっくり理解していきたいと思います。
ＶＢＡの勉強をしていきたいと改めて思いました。

回答No.2

Wendy02

こんばんは。

#1の回答者ですが、

>「実行時エラー '53':ファイルが見つかりません。」

その問題は、もともと、フォルダがないのか、それとも、パスの書き方を間違えたか、どちらかです。　「.　(コンマ）」しか出てこないなら、そこにフォルダはありません。

Sub フォルダ名一覧作成()
　　Dim フォルダ As String
　　Dim フォルダ名 As String
　　Dim 行 As Long

　　フォルダ = Cells(1, 2).Value
　　If Right(フォルダ, 1) <> "\" Then
　　　 フォルダ = フォルダ & "\"
　　End If

　　フォルダ名 = Dir(フォルダ & "*.*", vbDirectory)
　　Cells(4, 1).Value = フォルダ名

　　行 = 4
　　Do Until Len(フォルダ名) = 0
　　　　　If GetAttr(フォルダ & フォルダ名) = vbDirectory Then
　　　　　　　　Cells(行, 1).Value = フォルダ名
　　　　　　　　行 = 行 + 1
　　　　　End If
　　　　フォルダ名 = Dir()
　　Loop
End Sub

お礼

できました！
ありがとうございます！
フォルダ名も出てくるのですが、コンマも出てきます。
その辺はわからないですが、
やりたいことはできました。
素早い対応に感謝しています。

回答No.1

Wendy02

こんばんは。

>フォルダ名の一覧をExelのシートに書き出したいのです。

あまり、やったことがないけれど、こんなかんじですか？

Sub フォルダ名一覧作成()
　　Dim フォルダ As String
　　Dim フォルダ名 As String
　　Dim 行 As Long

　　フォルダ = Cells(1, 2).Value & "\"
　　フォルダ名 = Dir(フォルダ & "*.*", vbDirectory)
　　Cells(4, 1).Value = フォルダ名

　　行 = 4
　　Do Until Len(フォルダ名) = 0
　　　　　If GetAttr(フォルダ名) = vbDirectory Then
　　　　　　　　Cells(行, 1).Value = フォルダ名
　　　　　　　　行 = 行 + 1
　　　　　End If
　　　　フォルダ名 = Dir()
　　Loop
End Sub

お礼

さっそくのご回答ありがとうございます。

やってみたのですが、
　　If GetAttr(フォルダ名) = vbDirectory Then
の行で止まり、
「実行時エラー '53':
ファイルが見つかりません。」
というエラーメッセージが出てしまいます。

どうしたらいいでしょうか？
お手数をおかけしますが、またご回答いただけると助かります。