VBAでファイルシステムを制御できると、便利でもファイルとフォルダー属性次第で、エラーが出たりして手探り状態になった ー FileSystemObject（エクセルVBA）

写真のようなフォルダー階層があり、各フォルダーにもファイルが存在します。

メインフォルダーもファイルが在って、その全体を把握したい時、どうするか。

エクセルを起動し、VBAプログラムを回して、表に書き込めたら便利でしょう。

なので、ファイルシステムオブジェクトのプログラムを書いたから紹介します。

もし、サブフォルダーにファイルがなければ、”No File”の表示で確認できます。

加えて、ファイル名の項目も”N/A”（適用無し）と表示されるようにしました。

ただ、ある程度、色々なフォルダーで実験すると、エラーが発生して困ります。

良く分からないのですが、隠しフォルダーの存在があり、属性は1046でした。

イミディエイトウインドウでは、”My Music”で英語のサイトでも引用がある。

それで、この属性を持つフォルダーをスキップすると、最後まで動きました。

サンプル行も加えておきますが、エラー発生位置を探れるようになっています。

自分の場合、属性値次第でエラーが起きる場合にスキップするようにしました。

他にも、何かエラーが出ると属性値の関係だと思いますが、一筋縄でいかない。

というわけで、ファイルシステムオブジェクトは奥が深くて一歩前進一歩後退。

この他、フォルダー内のファイル情報が漏れ出て、シートに重複で書き込む等。

色々な挙動で怪現象の起きるフォルダーもあったりで、原因が特定できません。

そんな場合は、フォルダーのファイルの属性を調査しつつ、回避できるようなコードを書き足しては、最後までプログラムが走るように手直しを掛ける自分がいるのでした。

＜サンプルコード：モジュールに記述＞

Private Sub Auto_Open() 'ファイル起動で自動実行

  ActiveSheet.Cells.Clear

    ActiveSheet.Cells(1, 1) = "FolderName"

    ActiveSheet.Cells(1, 2) = "FileName"

    ActiveSheet.Cells(1, 3) = "FileSize(KB)" '項目見出しの追記

Call EachGetFolder

End Sub

Sub EachGetFolder()

Dim FSO As FileSystemObject, pfl As Folder, fl As Folder, FlPath As String

Dim Nme As String, TrgtFile As file, i As Long, j As Long, Fle As Object

Dim Rng As Range

  Set FSO = New FileSystemObject ' インスタンス化

  Set pfl = FSO.GetFolder(ThisWorkbook.Path) ' 親フォルダを取得

i = 2 '2行目以降にデータを書き込む変数

  For Each Fle In pfl.Files 'メインフォルダ直下のファイル列挙

       If InStr(Fle.Name, ThisWorkbook.Name) <> 0 Then GoTo Skip

      ActiveSheet.Cells(i, 2) = Fle.Name

      ActiveSheet.Cells(i, 3) = Fle.Size

      i = i + 1

Skip:

  Next Fle

For Each fl In pfl.SubFolders ' サブフォルダの一覧を取得

  'Debug.Print fl.Name & "  " & fl.Attributes

  ' If fl.Attributes = 1046 Then GoTo Skip2

   'エラーで上記2行のコメントを外して、エラー内容を調査、1046だけ解明。

 If fl.Size = 0 Then  'サブフォルダーにファイルがない時

     ActiveSheet.Cells(i, 1) = fl.Name

     ActiveSheet.Cells(i, 2) = "No File"

    ActiveSheet.Cells(i, 3) = "N/A"

    i = i + 1

 ElseIf fl.Size > 0 Then  'サブフォルダーにファイルがある時

    FlPath = fl.Path  'Debug.Print (fl.Path)

    j = FSO.GetFolder(FlPath).Files.Count

 End If

   For Each TrgtFile In FSO.GetFolder(FlPath).Files

 'If内でループ処理、フォルダ内の全ファイルについて処理

      If j = FSO.GetFolder(FlPath).Files.Count Then

         ActiveSheet.Cells(i, 1) = fl.Name

         ActiveSheet.Cells(i, 2) = TrgtFile.Name

         ActiveSheet.Cells(i, 3) = TrgtFile.Size

      '一個目のファイル行にフォルダ名を記載

      ElseIf j < FSO.GetFolder(FlPath).Files.Count Then

         ActiveSheet.Cells(i, 2) = TrgtFile.Name

         ActiveSheet.Cells(i, 3) = TrgtFile.Size

      '二個目以降のファイル行はフォルダ名を記載しない

      End If

         i = i + 1

         j = j - 1

  Next TrgtFile

Skip2: '属性値エラーが出た場合のスキップするポイント

Next fl

      Set FSO = Nothing ' 後始末

For Each Rng In Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row)

Rng = Round((Val(Rng) / 1000), 1)

Next Rng 'ファイルサイズをキロバイト、小数点一位に変換

      Column　s.AutoFit '書き込んだ表（行）を見やすくする。

End Sub

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村