VBAサンプル集
エクセルでファイル一覧を作成.№7(FileSystemObject2)

ExcelマクロVBAでファイル一覧を作成、サブフォルダ以下を全て取得
最終更新日:2014-11-11

エクセルでファイル一覧を作成.№7(FileSystemObject2)


エクセルでファイル一覧を作成します、

サブフォルダ以下も全て取得し、一覧表示します、


前回の予告通り、今回は再帰処理を実装します。


その前に、


再帰処理とは


簡単に言えば、自分自身をCallすることです、「再帰呼び出し」と言います。

同じ処理を繰り返し行う場合に使用します。

同じ処理を繰り返すと言うと、Do~Loopや、For~Nextが思い浮かびます。

そうですね、同じと言えば同じ、違うと言えば違う(笑)

再帰処理の多くは、Do~Loopや、For~Nextでも記述できます。

また、逆に、Do~Loopや、For~Nextを再帰処理で行う事も可能です。

要はプログラムの解り易さの問題だと言っても過言ではありません。


再帰処理をする為には、プロシージャーの引数や機能をしっかりする必要があります。

どんな引数を渡し、どんな処理をさせるのかです。

これをしっかり設計する必要があります。

そして、この思考の過程が重要で、とても役に立つのです。

再帰処理以外でも、モジュールを作成する時の基本的な考え方になるのです。



引数のByRefとByValについて


ByRef

「参照渡し」と呼ばれます。

変数を渡されたプロシージャー側で引数の値を変更すると、

呼び出し元のプロシージャーに戻った時に、変数の値も変わっています。


ByVal

「値渡し」と呼ばれます。

プロシージャに値を渡すだけです。

変数を渡されたプロシージャー側で引数の値を変更しても、

呼び出し元のプロシージャーに戻った時に、変数の値は変わりません。
VBAでは、省略時は、ByRef になっています。



では、前回のプログラムを再帰処理にする為にはどうするかですが、


まず、どのような機能のモジュールを作り、どんな引数が必要かを考えます。


必要な機能は、


1.フォルダ内のサブフォルダとファイルの一覧を作成する。


2.サブフォルダを取得した時は、自分自身を呼び出す。


これを繰り返せば、全ての一覧が作成されることになります。


従って、引数は、


1.フォルダは必要ですね


2.出力先のシートの位置(とりあえずは行数のみ)も必要です


以上を頭に入れて、前回のプログラムを見てみましょう。




Sub ファイル一覧取得()
  Dim objFSO As FileSystemObject
  Dim objFolder As Folder
  Dim objFolderSub As Folder
  Dim objFile As File
  Dim strDir As String
  Dim i As Long
  
  strDir = Cells(4, 2)
  Set objFSO = New FileSystemObject
  If Not objFSO.FolderExists(strDir) Then
    MsgBox ("指定のフォルダは存在しません")
    Exit Sub
  End If
  
  i = 5
  Set objFolder = objFSO.GetFolder(strDir)
  For Each objFolderSub In objFolder.SubFolders
    Cells(i, 2) = objFolderSub.Name
    i = i + 1
  Next

  

  For Each objFile In objFolder.Files
    With objFile
      Cells(i, 2) = .Name
      Cells(i, 3) = WorksheetFunction.RoundUp(.Size / 1024, 0)
      Cells(i, 3).NumberFormatLocal = "0 ""KB"""
      Cells(i, 4) = .DateLastModified
      i = i + 1
    End With
  Next

  Set objFSO = Nothing

  Set objFolder = Nothing

  Set objFolderSub = Nothing
End Sub


太字の部分が、繰り返し処理をしたい部分になります。


つまり、再帰処理するモジュールになります。



まずは単純に、この太字の部分を別モジュールにして、Callするように修正します。


Sub ファイル一覧取得()
  Dim objFSO As FileSystemObject
  Dim objFolder As Folder
  Dim objFolderSub As Folder
  Dim objFile As File
  Dim strDir As String
  Dim i As Long
  strDir = Cells(4, 2)
  Set objFSO = New FileSystemObject
  If Not objFSO.FolderExists(strDir) Then
    MsgBox ("指定のフォルダは存在しません")
    Exit Sub
  End If
  i = 5
  Set objFolder = objFSO.GetFolder(strDir)
  Call GetDirFiles(objFolder, i)
  Set objFSO = Nothing
End Sub

Sub GetDirFiles(ByVal objFolder As Folder, ByRef i As Long)
  Dim objFolderSub As Folder
  Dim objFile As File

  For Each objFolderSub In objFolder.SubFolders
    Cells(i, 2) = objFolderSub.Name
    i = i + 1
  Next

  For Each objFile In objFolder.Files
    With objFile
      Cells(i, 2) = .Name
      Cells(i, 3) = WorksheetFunction.RoundUp(.Size / 1024, 0)
      Cells(i, 3).NumberFormatLocal = "0 ""KB"""
      Cells(i, 4) = .DateLastModified
      i = i + 1
    End With
  Next
  Set objFolderSub = Nothing
End Sub


何も変わっていません。


太字の部分を別モジュールにして、Callするようにしただけです。


変数もそのまま全て残してあります。


当然、全く同じ動作をします。


そして、


Sub GetDirFiles(ByVal objFolder As Folder, ByRef i As Long)
を、よく見て下さい。

フォルダと行位置さえ渡されれば、全て処理してくれます。

つまり、フォルダと行位置を変えて、Callすればよいのです。


そこで、サブフォルダを取得したら、そのサブフォルダを引数にして、

このモジュール、つまり自分自身をCallしてやるのです。


For Each objFolderSub In objFolder.SubFolders
  Cells(i, 2) = objFolderSub.Name
  i = i + 1

  Call GetDirFiles(objFolderSub, i)
Next


これで再帰処理の完成です。


順序よく考えれば難しい事はありません。


いきなり、再帰処理を書こうとして、そのモジュールを書き始めたとしたら、


頭を悩ませるだけです。


一つ一つ積み重ねていけば、自然と出来上がります。



以下は不必要な変数を消したりして、少し体裁を整えたプログラムです。




Sub ファイル一覧取得()
  Dim objFSO As FileSystemObject
  Dim strDir As String
  Dim i As Long
  
  strDir = Cells(4, 2)
  'FileSystemObjectのインスタンスの生成
  Set objFSO = New FileSystemObject
  'フォルダの存在確認
  If Not objFSO.FolderExists(strDir) Then
    MsgBox ("指定のフォルダは存在しません")
    Exit Sub
  End If
  i = 5 '開始行位置
  '再帰処理モジュールのコール
  Call GetDirFiles(objFSO.GetFolder(strDir), i)
  'オブジェクトの解放
  Set objFSO = Nothing
End Sub

Sub GetDirFiles(ByVal objFolder As Folder, ByRef i As Long)
  Dim objFolderSub As Folder
  Dim objFile As File
  'サブフォルダの取得
  For Each objFolderSub In objFolder.SubFolders
    Cells(i, 2) = objFolderSub.Name
    i = i + 1
    Call GetDirFiles(objFolderSub, i)
  Next
  'ファイルの取得
  For Each objFile In objFolder.Files
    With objFile
      Cells(i, 2) = .Name
      Cells(i, 3) = WorksheetFunction.RoundUp(.Size / 1024, 0)
      Cells(i, 3).NumberFormatLocal = "0 ""KB"""
      Cells(i, 4) = .DateLastModified
      i = i + 1
    End With
  Next
  'オブジェクトの解放
  Set objFolderSub = Nothing
  Set objFile = Nothing
End Sub


どうでしょうか。


大分、すっきり、さっぱり、あっさりしましたね(笑)


Dir関数を使っていた時から、さほどステップ数も増えていません。


これで、指定フォルダ配下の全サブフォルダとファイルが取得できるようになりました。


次回以降で、見やすい出力形式にしてやれば完成です。


でも、サブフォルダの下のファイルをインデントしたり、罫線を引いたりが残っています。


これはこれで、結構大変なんですが・・・


まあ、少しづつやりましょう。





同じテーマ「ファイル一覧を作成」の記事

エクセルでファイル一覧を作成.№1(概要)
エクセルでファイル一覧を作成.№2(Dir関数1)
エクセルでファイル一覧を作成.№3(Dir関数2)
エクセルでファイル一覧を作成.№4(FileLen,FileDateTime)
エクセルでファイル一覧を作成.№5(FileDialog)
エクセルでファイル一覧を作成.№6(FileSystemObject1)
エクセルでファイル一覧を作成.№7(FileSystemObject2)
エクセルでファイル一覧を作成.№8(インデント)
エクセルでファイル一覧を作成.№9(罫線)
エクセルでファイル一覧を作成.№10(完成)


新着記事NEW ・・・新着記事一覧を見る

VBA100本ノック 18本目:名前定義の削除|VBA練習問題100(11月6日)
VBA100本ノック 17本目:重複削除(ユニーク化)|VBA練習問題100(11月6日)
VBA100本ノック 16本目:無駄な改行を削除|VBA練習問題100(11月5日)
VBA100本ノック 15本目:シートの並べ替え|VBA練習問題100(11月4日)
VBA100本ノック 14本目:社外秘シート削除|VBA練習問題100(11月3日)
VBA100本ノック 13本目:文字列の部分フォント|VBA練習問題100(11月1日)
VBA100本ノック 12本目:セル結合を解除|VBA練習問題100(10月31日)
VBA100本ノック 11本目:セル結合の警告|VBA練習問題100(10月30日)
VBA100本ノック 10本目:行の削除|VBA練習問題100(10月29日)
VBA100本ノック 9本目:フィルターコピー|VBA練習問題100(10月28日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
5.マクロって何?VBAって何?|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ