エクセルでファイル一覧を作成 | エクセルでファイル一覧を作成.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関数を使っていた時から、さほどステップ数も増えていません。


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


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


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


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


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






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

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

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

SUMIFの間違いによるパフォーマンスの低下について|エクセル関数超技(6月17日)
条件式のいろいろな書き方:TrueとFalseの判定とは|ExcelマクロVBA技術解説(6月15日)
空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)

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

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い方|ExcelマクロVBA入門
3.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
4.変数とデータ型(Dim)|ExcelマクロVBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
6.定数と型宣言文字(Const)|ExcelマクロVBA入門
7.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
8.マクロって何?VBAって何?|ExcelマクロVBA入門
9.CSVの読み込み方法|ExcelマクロVBAサンプル集
10.ひらがな⇔カタカナの変換|エクセル基本操作



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

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


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

    ↑ PAGE TOP