Excelスキルアップコレクション
           〜 Something U Want 〜


Google  

WWW を検索
Excelスキルアップコレクション内 を検索
 @     Top  >     Excel VBA スキルアップコレクション Topics  >     (21) フォルダ内に存在するサブフォルダの一覧を作成する

 
(21) フォルダ内に存在するサブフォルダの一覧を作成する

 フォルダ内に存在するフォルダ(※サブフォルダ)の一覧を作成する方法を紹介します。

 Dir() 関数を紹介します。
Dir(パス条件式, vbDirectory)フォルダ名を表す条件式を{パス条件式}に指定してDir()関数を呼 び出せば、条件に見合うフォルダの中で、最初に見つかったフォルダ名が戻り 値として帰ります。条件に見合うフォルダが存在しない場合は空文字""が返り ます。条件に見合うフォルダが複数存在する場合で、二番目以降のフォルダ名 を得るには、Dir()関数の{パス条件式}を省略して呼び出します。返される値 が空文字になるまでそれを繰り返すことで、フォルダ一覧を作成することがで きます。
 以下のようなフォルダ「C:\Sample」を対象に、サブフォルダの一覧を作成するサンプルを紹介します。
  
 下記サンプルコードは、Dir()関数を使用したサンプルです。

 1行目:  Public Sub make_FolderList_01()
 2行目:  
 3行目:      ' 単純なループカウンタ
 4行目:      Dim lp As Long
 5行目:  
 6行目:      ' 「C:\Sample」フォルダ配下に存在するサブフォルダ名を取出す為の変数
 7行目:      Dim folderName As String
 8行目:      
 9行目:      ' 「C:\Sample」フォルダ配下に存在するサブフォルダ名を取出す。
10行目:      folderName = Dir("C:\Sample\*", vbDirectory)
11行目:  
12行目:      ' サブフォルダ名をシート上に出力する為のカウンタ
13行目:      Dim cnt As Long
14行目:      cnt = 0
15行目:  
16行目:      Do While folderName <> vbNullString
17行目:          ' 現在のフォルダと親フォルダを無視する。
18行目:          If folderName <> "." And folderName <> ".." Then
19行目:              ' フォルダであるか判別する。
20行目:              If GetAttr("C:\Sample\" & folderName) = vbDirectory Then
21行目:                  ' フォルダ名をシート上に出力する。
22行目:                  Range("A1").Offset(cnt, 0).Value = folderName
23行目:                  cnt = cnt + 1
24行目:              End If
25行目:          End If
26行目:          folderName = Dir()
27行目:      Loop
28行目:  
29行目:  End Sub
 このサンプルコードを実行すると、以下の結果になります。
<実行前>

<実行後>

  10行目のDir()関数の引数は、「"C:\Sample"」ではなく、「"C:\Sample\*"」です。最後の「"*"」は省略しても構いませんが、「"Sample"」の後ろに「"\"」を付けなければなりません。「"\"」を付けなければ、Dir()関数は、「"C:\"」配下から「"Sample"」と言うフォルダを探す条件が指定されたのだと解釈されてしまいます。
  ここで紹介している方法では、Dir()関数の第二引数にvbDirectoryを指定していますが、Dir()関数は、サブフォルダ以外にも、現在のフォルダ「"."」、親フォルダ「".."」、ファイル名も返します。そこで、18行目、20行目の判定文を用いて、サブフォルダ名のみに絞り込む作業が必要になります。これらの判定文がコードに存在しなければ、実行結果は以下のようになってしまいます。
  フォルダ内に存在するサブフォルダの一覧を作成する方法として、Dir()関数を利用する方法以外に、FileSystemObjectを利用する方法もあります。
  下記サンプルコードは、FileSystemObjectを利用してサブフォルダ一覧を作成するサンプルです。

 1行目:  Public Sub make_FolderList_02()
 2行目:  
 3行目:      ' FileSystemObjectを作成する。
 4行目:      Dim Obj As Object
 5行目:      Set Obj = CreateObject("Scripting.FileSystemObject")
 6行目:  
 7行目:      ' フォルダ名をシート上に出力する為のカウンタ
 8行目:      Dim cnt As Long
 9行目:      cnt = 0
10行目:  
11行目:      ' 「C:\Sample」フォルダ配下に存在するフォルダを一つずつ参照する。
12行目:      Dim f As Object
13行目:      For Each f In Obj.GetFolder("C:\Sample").SubFolders
14行目:          ' フォルダ名をシート上に出力する。
15行目:          Range("A1").Offset(cnt, 0).Value = Obj.GetFolder(f).Name
16行目:          cnt = cnt + 1
17行目:      Next f
18行目:      
19行目:      ' オブジェクトを破棄する。
20行目:      Set Obj = Nothing
21行目:      Set f = Nothing
22行目:  
23行目:  End Sub
 このサンプルコードを実行すると、以下の結果になります。
<実行前>

<実行後>

 サンプルコードの14行目の「.Name」を「.Path」に変更すると、シート上に出力されるサブフォルダ名は、フルパスになります。

…
14行目:      Range("A1").Offset(cnt, 0).Value = Obj.GetFolder(f).Path
…
ページの先頭へ