エクセルの学校


[[20050711132657]] 『VBA:フォルダ名の取得』(いま) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

|
| 全文検索 | 過去ログ | HOME ]

 

『VBA:フォルダ名の取得』(いま)
特定のパスの中にある全てのフォルダ名を取得し、シートに記載したいのですが・・・
どなたか良いアドバイスをお願いします。

C\test←このフォルダ内にある全てのフォルダ名を取得したいです。


 その階層まで? それ以下も?  フリーソフトもあると思うけど。
  (INA)


C\test内のフォルダ名です。それ以下はいりません。(いま)

 こんな感じでどうでしょうか?
VBEの画面でツール→参照設定→Microsoft Scripting Runtimeにチェックを入れてください。
Option Explicit
'要Microsoft Scripting Runtime参照設定
Sub てすと()
Dim MyFSO As Object
Dim MyFolder As Folder
Dim MyAry() As Variant
Dim i As Long
Set MyFSO = CreateObject("Scripting.FileSystemObject")
    With MyFSO
        With .GetFolder("C:\test\")
            ReDim MyAry(1 To .SubFolders.Count, 1 To 1)
            For Each MyFolder In .SubFolders
                i = i + 1
                MyAry(i, 1) = MyFolder.Name
            Next
        End With
    End With
With ActiveSheet
    .Range("A:A").ClearContents
    .Range("A1").Resize(UBound(MyAry, 1)).Value = MyAry
End With
Erase MyAry
Set MyFSO = Nothing
End Sub
(SoulMan)

SoulManさん  ありがとうございますm(_ _)m
Microsoft Scripting Runtimeにチェックを入れてください 上記にチェックを入れるとどうなるのですか?試してみたところ、
やりたい事が出来たので問題はないのですが・・・(いま)

すみません。便乗で質問させて頂いても宜しいでしょうか。
フォルダでなく、ファイル名のリストがほしい場合は、上のコードのどこを変更したらよいでしょうか。
たとえば、100個くらいある.jpgファイル名を一覧にしたい時などです。
(miyako)

 とりあえず、それらしきトピックを挙げておく。(みやほりん)
[[20050324161946]]『指定したフォルダのファイルリストを作りたい』(HIDE) 
[[20040611124306]] 『フォルダ内のファイル一覧を表示するマクロ』(しげちゃん) 
[[20031231133504]] 『fdの中身一覧印刷』(北新宿mh) 

ありがとうございました。とても助かりました。(miyako)

 こんにちは!
 みやほりんさん、フォローありがとうございます。m(__)m
 >Microsoft Scripting Runtimeにチェックを入れてください
 >上記にチェックを入れるとどうなるのですか
 あっぁ〜〜、、そうきたかぁ、、(^^;
どうなるんでしょうね??まぁ、、簡単にいうと・・・
使えないのもが使える様になる??
なんちゃって、、参照出来る様になるのね(^^;;;
まぁ、、私の説明はこんなもんですわ。。これでゆるじてね。。
もっと知識者の方の登場を一緒にまちましょうね。。
ところで、もうサンプルが出てますけどね、私流なら、、こんな感じでしょうか?
ではでは、頑張ってくださいね。
Option Explicit
Sub てすと()
Dim MyPic As String
Dim MyPath As String
Dim MyAry() As Variant
Dim k As Long
MyPath = "C:\test\"
MyPic = Dir(MyPath & "*.jpg")
Do Until MyPic = ""
    k = k + 1
    ReDim Preserve MyAry(1 To k)
    MyAry(k) = MyPic
    MyPic = Dir()
Loop
With ActiveSheet
    .Range("A:A").ClearContents
    If k > 0 Then
        .Range("A1").Resize(UBound(MyAry)).Value = Application.Transpose(MyAry)
    End If
End With
Erase MyAry
End Sub
#Transposeを使っているので数に制限があります。あしからずご了承くださいませ。
(SoulMan)

#Transposeを使っているので数に制限があります。 ということですが、ヘルプにTransposeがヒットしませんでした。
宜しければ、どのくらいまでいけるか教えていただけますか。
100くらいでは大丈夫のようでした。
1000くらいはどうでしょうか。1万くらいになると無理でしょうか。よろしくお願い致します。(miyako)

 5461 255 Null だったと思うけど、、いいページがあったんだけどね。
探したけど、みつからなかった。また、探しておきますね。
(SoulMan)

コメント:

[ 一覧(最新更新順) |

]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.