写真のようなフォルダー階層があり、各フォルダーにもファイルが存在します。
メインフォルダーもファイルが在って、その全体を把握したい時、どうするか。
エクセルを起動し、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
0 件のコメント:
コメントを投稿