[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダー内のファイル名のリストを抽出でエラー』（WWR362）
フォルダー内（複数サブフォルダーを含む）のファイル名のリストを抽出するのに
以下のマクロをネットを参考にテストしてみました。
途中までは抽出されるのですが以下コードでエラーが出ます。
fn = Dir() '変数fnに次のファイル名を格納（ファイルが無い場合は空欄になる）
実行エラー：５
プロシージャの呼び出し、または引数が不正です。
ファイル名を扱う場合に上記エラーが出る原因は何が有るでしょうか？
エラー原因の特定方法があれば教えてください。
Option Explicit
Sub 指定したフォルダ内とサブフォルダ内全部のファイル名取得()
'アクティブシートから処理対象のフォルダパスを取得し
'そのフォルダ内とサブフォルダ内全部のファイル名を全てアクティブシートに取得
'【変数】
Dim ws As Worksheet '処理対象シート
Dim pt As String '処理対象パス
Dim t_row As Long 'ファイル名書出行
'■変数セット
Set ws = Worksheets("DATA") '変数ws=アクティブシートをセット
pt = ws.Range("A3") '変数ptにセルA3のパスをセット
t_row = 6 'ファイル名を書き出す初めのセルの行番号をセット
'■指定したフォルダ内とサブフォルダ内全部のファイル名をセルに書き出し
Call ファイル名一覧取得(pt, ws, t_row)
End Sub
Sub ファイル名一覧取得(pt As String, ws As Worksheet, t_row As Long)
Dim FSO As Object 'FileSystemObject
Dim fn As String 'ファイル名
Dim s_fd As Object 'サブフォルダ
fn = Dir(pt & "\*.*") '変数fnに1個目のファイル名を格納
Do While fn <> "" 'fnが空欄になるまでDo While内の処理を続ける
ws.Cells(t_row, 1) = fn '対象セルにファイル名を書き出し
t_row = t_row + 1 'ファイル名を書き出すセルの行番号+1（一つ下の行番号）
fn = Dir() '変数fnに次のファイル名を格納（ファイルが無い場合は空欄になる）
Loop
Set FSO = CreateObject("Scripting.FileSystemObject") 'FileSystemObjectのインスタンス化
For Each s_fd In FSO.GetFolder(pt).SubFolders '変数s_fdに対象フォルダ内のサブフォルダを順に取得
Call ファイル名一覧取得(s_fd.Path, ws, t_row) '再帰処理
Next s_fd
Set FSO = Nothing 'FSOを空っぽにする
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
（ruuto） 2022/12/31(土) 16:04:46
Call ファイル名一覧取得 の部分で
「コンパイルエラー」がでます。
引数は省略出来ません。
（WWR362） 2022/12/31(土) 16:38:35
問題のエラーは、ファイル名の文字数（長さ）が長すぎるからでしょうか？
最後までエラー無く処理されたので問題は無いのですが
処理されるべきファイルの総数が抽出された総数と一致しているかをチェックしたいのですが
フォルダー内（複数サブフォルダーを含む）のファイルの総数を算出する方法を教えてください。
又、
書き出されるファイルの順番は、フォルダーをソートした順番では無さそうなのですが
どのような順番で抽出されているのでしょうか ？
（WWR362） 2022/12/31(土) 17:09:26
（abc） 2022/12/31(土) 18:08:40
>以下のマクロをネットを参考にテストしてみました。
参考にしたとこどこ？ （byval） 2022/12/31(土) 23:12:39
MKさん、隠しファイルや一時ファイルは無いので考慮していません。
アドバイスによりコードを作成してみました。
ネットの情報を頼りにトライしてエラーが出るのでコード修正を修正すると言う
初心者のアプローチなので思うような処理が出来ていません。
書き出されたファイル数（A列に連番を作成）は求められているので
後は、VBAでフォルダープロパティを見るようにしてファイル数をセル(D3)に表示して
比較するようにコードを作成したのですがうまく表示されません。
以下のコードを見てアドバイスをお願いします。
'--------------------------------------------------------------------------
Option Explicit
Sub 指定したフォルダ内とサブフォルダ内全部のファイル名取得_FileSystemObject()
Dim Path As String
Dim Ws As Worksheet
Set Ws = Sheets("DATA")
'ターゲットフォルダーの指定
Path = Ws.Range("A3")
'書き出し行の初期化(6行目以降をクリアー)
Ws.Rows("6:" & Cells.Rows.Count).ClearContents
'書き出しセルの指定
Ws.Range("B6").Select
'ファイル名リストの書き出しサブルーチン呼び出し
GetFileList01 Path
Stop
'フォルダ情報取得 サブルーチンの呼び出し
フォルダ情報取得 Path
Stop
'-------------------------------------------
'ファイル名の有るB列の最終行までA列に連番を付ける
Dim maxRow, i, ii As Long
'B列の最終行を求めてmaxRow変数に値を代入
If Len(Ws.Range("B6").Value) = 0 Then
maxRow = 0
ElseIf Len(Ws.Range("B7").Value) = 0 Then
maxRow = 1
Else
maxRow = Ws.Range("B6").End(xlDown).Row
End If
'B列の最終行の取得結果に応じて作業を分岐
If maxRow > 0 Then
i = 1 '連番の初期値
'ナンバリング処理
For ii = 6 To maxRow
Range("A" & ii).Value = i
i = i + 1
Next
MsgBox ("処理が終了しました。")
Else
'メッセージを表示して終了（エラー）
MsgBox ("ファイルリストがB列に無いので作業を中断しました。")
End If
End Sub
Sub GetFileList01(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False
Set objFs = CreateObject("Scripting.FileSystemObject")
'パスの取得
For Each objFolders In objFs.GetFolder(Search_Path).subFolders
'サブフォルダまで検索するために再帰実行
GetFileList01 objFolders.Path
Next
'ファイル名の取得
For Each objFiles In objFs.GetFolder(Search_Path).Files
'セルにファイル名を書き込む
ActiveCell.Value = objFiles.Path
'次の書き出しに備えて行を進める
ActiveCell.Offset(1, 0).Select
Next
End Sub
Sub フォルダ情報取得(Searth_Path)
Dim Ws As Worksheet
Set Ws = Sheets("DATA")
Dim dblSize As Double
Dim sDir As String
sDir = Searth_Path
' dblSize = フォルダサイズ取得(sDir)
'
' Range("A1").Value = dblSize
' Range("B1").Value = "バイト"
' Range("A2").Value = Int(dblSize / 1024)
' Range("B2").Value = "KB"
' Range("A3").NumberFormatLocal = "0.00"
' Range("A3").Value = dblSize / 1024 / 1024
' Range("B3").Value = "MB"
' Range("A4").NumberFormatLocal = "0.00000"
' Range("A4").Value = dblSize / 1024 / 1024 / 1024
' Range("B4").Value = "GB"
'
Dim lFolderCount As Long
Dim lFileCount As Long
フォルダ数ファイル数取得 sDir, lFolderCount, lFileCount
'
' Range("A5").Value = lFolderCount
' Range("B5").Value = "フォルダ数"
' Ws.Range("A6").Value = lFileCount
Ws.Range("D3").Value = "ファイル数"
End Sub
Private Function フォルダサイズ取得(sDir As String) As Double
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
フォルダサイズ取得 = fso.GetFolder(sDir).Size
End Function
Private Sub フォルダ数ファイル数取得(strTargetDir As String, ByRef lFolderCount As Long, ByRef lFileCount As Long)
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strTargetDir)
lFolderCount = lFolderCount + folder.subFolders.Count
lFileCount = lFileCount + folder.Files.Count
For Each subfolder In folder.subFolders
'再帰的にチェック
フォルダ数ファイル数取得 subfolder.Path, lFolderCount, lFileCount
Next subfolder
End Sub
（WWR362） 2023/01/01(日) 07:34:19
（abc） 2023/01/01(日) 13:27:55
わかりにくいですよね。
簡単な完成形のイメージ（レイアウト）が下記のようになります。
ファール名(D:\ABC)内のファイル名を抽出
その結果、３つがセルに書き出されたとすれば
B列のファイルのナンバリングのA列の数値とフォルダーのプロパティから求めたD3の数値を比較
A8の数値(3)とD3の数値(3)を比較して同じであれば問題なく処理されていると推定
A B C D 1 2 フォルダー名 ファイル数(From Propaty) 3 D:\ABC 3 4 5 No. 抽出ファイル 6 1 D:\ABC\ももクロ.txt 7 2 D:\ABC\船橋.txt 8 3 D:\ABC\大阪道頓堀.txt
（WWR362） 2023/01/01(日) 13:54:56
(1)少なくとも、サブフォルダがある例を示されては？
A3セルがルートの（つまり最上位の）フォルダ名ですね。
その下にあるサブフォルダ（やその配下のファイルたち）は、
どこにどのように配置するんですか？
(2)ファイル数のプロパティとは、コードではどこにありますか？ なんというプロパティですか？
(3)それはそのフォルダの下にあるサブフォルダ内のファイルも含めるのですか？
以上3点を明確にされるとよろしいのでは？
そのほうがコメントが付きやすいと思います。
（abc） 2023/01/01(日) 17:09:59
ルートフォルダの配下にあるファイルはサブフォルダで分ける必要もないのですね。 それは失礼しました。
それなら、下記のようなことでは？
変更した主要な点は以下の二つです。 1. FileSystemObjectは一度だけ定義して、それを使いまわすことでよいと思います。 2. ファイルの連番は、ファイル名と同時に実行して問題ないと判断しました。
==== 以下、参考コード ============ Option Explicit
Dim fso As Object Dim ws As Worksheet Dim r As Long Dim num As Long
Rem 指定したフォルダ内とサブフォルダ内全部のファイル名取得
Sub main()
Dim rootPath As String
Set ws = Sheets("DATA")
Set fso = CreateObject("Scripting.FileSystemObject")
'ターゲットフォルダーの指定
rootPath = ws.Range("A3")
Application.ScreenUpdating = False
'書き込み先の設定
ws.Rows("6:" & Cells.Rows.Count).ClearContents
r = 6 '書き込み先の行番号
num = 1 '通し番号
'ファイル名リストの書き出し
getFileList rootPath
フォルダ情報取得 rootPath
Application.ScreenUpdating = True
End Sub
REM フォルダ配下の全ファイルをシートに書き出す（再帰実行）
Sub getFileList(Search_Path)
Dim objFiles As Object, objFolders As Object
For Each objFiles In fso.GetFolder(Search_Path).Files
ws.Cells(r, "B") = objFiles.Path
ws.Cells(r, "A") = num
r = r + 1
num = num + 1
Next
'パスの取得
For Each objFolders In fso.GetFolder(Search_Path).subFolders
getFileList objFolders.Path
Next
End Sub
Sub フォルダ情報取得(Searth_Path)
Dim sDir As String
Dim lFolderCount As Long
Dim lFileCount As Long
sDir = Searth_Path
フォルダ数ファイル数取得 sDir, lFolderCount, lFileCount
ws.Range("D3").Value = lFileCount
End Sub
Private Sub フォルダ数ファイル数取得(strTargetDir As String, _
ByRef lFolderCount As Long, ByRef lFileCount As Long)
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Set folder = fso.GetFolder(strTargetDir)
lFolderCount = lFolderCount + folder.subFolders.Count
lFileCount = lFileCount + folder.Files.Count
For Each subfolder In folder.subFolders
フォルダ数ファイル数取得 subfolder.Path, lFolderCount, lFileCount
Next subfolder
End Sub
（abc） 2023/01/01(日) 23:00:38
提示いただいたコードは、完璧です。
試用の結果、求めるフォルダーのプロパティから求めたファイルの総数が表示されました。
協力ありがとうございました。
（WWR362） 2023/01/02(月) 08:45:19
誤解があってはいけないので、コメントしておくと、 folder.Files.Countを使ってカウントしているので、 コードではファイル数カウントが一致するのは自明な話です。 （同じFileSystemObjectの中のFilesを使った話ですから。）
「フォルダのプロパティから求めたファイルの総数」と 一致するかどうかはまた別の話かもしれません。 FSOの仕組みを詳細調べた訳ではないので、 それが本来プロパティの値と一致するものかどうかは知りません。 （隠しファイルやシステムファイルの存在も考慮したときにということ） （abc） 2023/01/02(月) 13:50:57
FSOで求めた数値が本来プロパティの値と一致するものかどうかは分からないとの事ですね。
私の調べたネットの参考記事は、以下のURLですが
https://beiyan-tool.info/?p=851
記事をもう一度読むと
「フォルダを右クリックして、プロパティを表示するときと似たような内容を取得することができます。」
と記載されています。
”似たような”なのでプロパティで表示される数値とイコールとは述べていませんでした。
（WWR362） 2023/01/02(月) 17:15:54
# 参考記事は余り根拠になるような性質の記事ではないと思いました。(またまた余計なことですが）
（abc） 2023/01/02(月) 18:17:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.