[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダの階層を開くには』（ぽんぞう）
いつもお世話になっています。 一つ質問があるのですが、 Dir関数にてフォルダ内のデータを操作していますが、これが多数のフォルダがある場合の選択肢はありますか？
現在のコードです。
Sub 進捗管理仕様書_集計()
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long
myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用" '処理したいフォルダ名のパス
fn = Dir(myDir & "*進捗管理仕様書*.xls") 'ワイルドカード実行（抽出したいファイル名）
ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にファイル名を作成する
a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数
a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn) '変数wbにフォルダ名とファイル名を格納
For Each ws In wb.Sheets
If ws.Range("a4").Value = "生物販" Then 'a4セルに文字列が存在した場合
n = n + 1
With ws.Range("h5", ws.Range("h" & Rows.Count).End(xlUp)) 'h5を基点とする
a(n, 1) = fn '対象となったファイル名
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'hから12列目のt列（ケース数にあたる）の集計
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(1, 1)), "") 'ケース数がない場合は、i列の文字列（空白以外）をカウントする
a(n, 4) = SumIfIf(.Offset(, 5), .Offset(, 12), "合格") 'm列の合格数
End With
End If
Next
wb.Close False '保存せずにブックを閉じる
fn = Dir()
Loop
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理
End Sub
アプリ進捗資料用のフォルダ内に集計するブックを一つずつ各フォルダを開いて、移動する作業を日々実行しています。 通常は何層にもフォルダがあり、それを一つのフォルダに収めてから作業をしています。
改善したいところは、アプリ進捗資料用フォルダ内だけの実行ではなく、
アプリ進捗資料用（フォルダ） →東京（フォルダ） →部品（フォルダ） →*進捗管理仕様書*.xls（ブック） ： →入荷（フォルダ） →*進捗管理仕様書*.xls（ブック） ： →大阪（フォルダ） →部品（フォルダ） →*進捗管理仕様書*.xls（ブック） ： →入荷（フォルダ） →*進捗管理仕様書*.xls（ブック） ：
アプリ進捗資料用にある東京と大阪のフォルダ内の更に配下の部品・入荷のフォルダの対象となるブックまで集計する。
このような作業は可能でしょうか。
PathNameを変更してみても、やはり一つのフォルダ内しか反映されませんでした。
myDir = "C:\Documents And Settings\ponzou\"
For Each e In Array("東京\","大阪\")
For Each s In Array("部品\","入荷\")
Set wb = Workbooks.Open(mydir & e & s & "*進捗管理仕様書*.xls")
とかにすればよいのでは？ あとは、FileSystemObjectを使用してSub Folderの取得とか... (seiya)
seiyaさん。 いつもありがとうございます。
各東京や大阪フォルダ内には、他にも多数フォルダ（たまに7フォルダくらい）が存在しているので、フォルダ毎に格納するのは中止しました。
fileSystemObjectの方法ですか..。
Dim fso, f1 As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile("c:\*進捗管理仕様書*.xls")
こんな感じにしてみるのでしょうか...？
（ぽんぞう）
For Each fldr In fso.GetFolders(myDir).SubFolders でsub folder名を収録できませんか？ (seiya)
seiyaさん。 >>For Each fldr In fso.GetFolders(myDir).SubFolders
ファイルが見つかりません。と実行時エラーがでてしまいました..。
（ぽんぞう）
myDir の最後の"\"は削除してありますか？ (seiya)
消してました。 他のコードが余分なのでしょうか..。
（ぽんぞう）
ためしにこんなコードを実行してみてはどうでしょうか？(ROUGE)
'----
If Not fso.FolderExists(myDir) Then
MsgBox "指定フォルダはありません。"
Else
MsgBox "指定フォルダはありました。" & vbLf & _
"さぶフォルダは " & fso.GetFolder(myDir).SubFolders.Count & " 個あります。"
End If
ROUGEさん。 ありがとうございます。
試してみたところ、
指定フォルダはありました。 さぶフォルダは２個あります。
とでてくれました♪フォルダの認証はされているようですよね..。
私も先程、
Dim FSO, FolderObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FolderObject = FSO.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
MsgBox FolderObject.SubFolders.Count
としたら、２つとでたのですが、その先の実行が行われませんでした(;^^)
（ぽんぞう）
For Each fldr In FolderObject Next でループさせてはどうでしょうか。。。
と書いたところで、seiyaさん！誤記がぁ...
seiyaさんが掲載されたもののうち、 GetFolders --> GetFolder とすれば動きませんか？ (ROUGE)
それ！ 今気がつきました。 (seiya)
seiyaさん、ROUGEさん。 昨日はありがとうございました。 割り込み作業が入ってしまい、お返事できずすみませんでした。
>>For Each fldr In FolderObject Next
オブジェクトが必要と実行エラーとなりました。
Set Fldr = FSO.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
じゃだめですよね..。
>>For Each fldr In fso.GetFolder(myDir).SubFolders
ForEachのネストは可能なのでしょうか？ Doの手前までをループさせたところ、反応しているのですが、Do以下の作業がされませんでした。
（ぽんぞう）
For Each fldr In FolderObject.SubFolders ですね。。。 (ROUGE)
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long, fso, fldr As Object
myDir = "C:\Documents and Settings\ponzou" '処理したいフォルダ名のパス
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
For Each fldr In FolderObject.SubFolders <-ここでオブジェクトエラー..Setの記述が違ってますか..
If Not fso.FolderExists(myDir) Then
MsgBox "指定フォルダはありません。"
Else
MsgBox "指定フォルダはありました。" & vbLf & _
"さぶフォルダは " & fso.GetFolder(myDir).SubFolders.Count & " 個あります。"
End If
fn = Dir(myDir & "*進捗管理仕様書*.xls") 'ワイルドカード実行（抽出したいファイル名） ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にファイル名を作成する a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数 a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
Next Do While fn <> "" ： ：
<-の部分でFor Each fldr In fso.GetFolder(myDir).SubFoldersとすると 指定フォルダはありました。 さぶフォルダは２個あります。
が、２回表示されます。
F8で一行ずつ試してみたのですが、If〜を一周したあと、Do...へはいかず、最終コードの
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理
まで一気に飛んでました...。これが原因ですか...？
（ぽんぞう）
Set fldr = -> Set obFolder = FoldreObject.Subfolders -> obFolder.Subfolders
に変更してみてください (seiya)
しょとつ。
↓が入っているのではないのですか？
> Set FolderObject = FSO.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
(ROUGE)
そうですね、文脈からすると... とにかく、Set Statement で fldr を参照するのはまずいですね。 (seiya)
seiyaさん。 上記に変更してみましたが、型が一致しないとコンパイルエラーが生じ、 ObjectをVariantに変更してみると、オブジェクトが必要と掲示..。
ROUGEさん。
Set FolderObject = FSO.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
↑
は、確認用に書いたので、すぐに消しました..。
現在は、
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long, fso, obFolder As Variant
myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用" '処理したいフォルダ名のパス
Set fso = CreateObject("Scripting.FileSystemObject")
Set obFolder = ("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
For Each fso In obFolder.Subfolders
If Not fso.FolderExists(myDir) Then
MsgBox "指定フォルダはありません。"
Else
MsgBox "指定フォルダはありました。" & vbLf & _
"さぶフォルダは " & fso.GetFolder(myDir).Subfolders.Count & " 個あります。"
End If
fn = Dir(myDir & "*進捗管理仕様書*.xls") 'ワイルドカード実行（抽出したいファイル名）
ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にファイル名を作成する
a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数
a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
Next
Do While fn <> "" <-ここからの作業がされない。
Set wb = Workbooks.Open(myDir & fn) '変数wbにフォルダ名とファイル名を格納
For Each ws In wb.Sheets
If ws.Range("a4").Value = "生物販" Then 'a4セルに文字列が存在した場合
n = n + 1
With ws.Range("h5", ws.Range("h" & Rows.Count).End(xlUp)) 'h5を基点とする
a(n, 1) = fn '対象となったファイル名
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'hから12列目のt列（ケース数にあたる）の集計
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(1, 1)), "") 'ケース数がない場合は、i列の文字列（空白以外）をカウントする
a(n, 4) = SumIfIf(.Offset(, 5), .Offset(, 12), "合格") 'm列の合格数
End With
End If
Next
wb.Close False '保存せずにブックを閉じる
fn = Dir()
Loop
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理
End Sub
です。
myDirとSet fsoの書き方は多重で必要ないですか..？
（ぽんぞう）
1) Set obFolder = FSO.GetFoler が抜けていますよ...
^^^^^^^^^^^^
2) For Each fso -> For Each fldr
For Each fldr In obFolder.SubFolders
MsgBox fldr.Name
Next
(seiya)
seiyaさん。
フォルダ名がMsgBoxで確認できました♪（東京と大阪のフォルダが認証）
なぜ、
Do While fn <> "" <-ここからの作業がされない。
Set wb = Workbooks.Open(myDir & fn) '変数wbにフォルダ名とファイル名を格納
fnの内容も変更してみましたが、変わらず。
アプリ進捗資料用のフォルダの中に、今はテスト用に二つ（東京と大阪）のフォルダがあり、 更に東京のフォルダに７つのフォルダ、そのフォルダの中に更にまたフォルダが９つ...。 ここでようやく"*進捗管理仕様書*.xls"のブックが存在するわけなのです。 それもfileSystemObjectで反映されているのですよね..。 （ぽんぞう）
それが確認できたら、そこからループですね
For Each fldr In obFolder.Subfolders
fn = Dir(myDir & "\" & fldr.Name & "\*進捗管理仕様書*.xls")
Do While fn <> ""
Loop
Next
みたいに
(seiya)
seiyaさん。
C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用\大阪\*進捗管理仕様書*.xlsが見つかりません。 ファイル名およびファイルの保管場所が正しいかどうか確認してください。とエラーが発生しました。
あとExit Forは使用しなくても可能でしょうか。
（ぽんぞう）
fn = Dir(myDir & "\" & fldr.Name & "\*進捗管理仕様書*.xls") ファイルが存在しなければ fn = "" になるので、 Do While fn <> "" ではじかれるはずです。 コードを提示してください。 (seiya)
seiyaさん。
Sub ケース数_集計()
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long, fso, obFolder As Variant
myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用" '処理したいフォルダ名のパス
Set fso = CreateObject("Scripting.FileSystemObject")
Set obFolder = fso.GetFolder("C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用")
For Each fldr In obFolder.SubFolders
fn = Dir(myDir & "\" & fldr.Name & "\" & "\*進捗管理仕様書*.xls") 'ワイルドカード実行（抽出したいファイル名）
ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にファイル名を作成する
a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数
a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
Next
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn) '変数wbにフォルダ名とファイル名を格納 <-ここの()内も変更してみたりしました。
For Each ws In wb.Sheets
If ws.Range("a4").Value = "生物販" Then 'a4セルに文字列が存在した場合
n = n + 1
With ws.Range("h5", ws.Range("h" & Rows.Count).End(xlUp)) 'h5を基点とする
a(n, 1) = fn '対象となったファイル名
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'hから12列目のt列（ケース数にあたる）の集計
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(1, 1)), "") 'ケース数がない場合は、i列の文字列（空白以外）をカウントする
a(n, 4) = SumIfIf(.Offset(, 5), .Offset(, 12), "合格") 'm列の合格数
End With
End If
Next
wb.Close False '保存せずにブックを閉じる
fn = Dir()
Loop
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理
End Sub
です。
Set wb = Workbooks.Open(myDir & fn) ここの部分でポイントされます。()内も変更してみましたが、不適当だったかもしれないです...。
（ぽんぞう）
Set wb = Workbooks.Open(myDir & "\" & fldr.Name & "\" & fn) に変更してください。
追記： myDir の最後にPathSeparater"\"が入っていますので、削除してください。 そのようにすれば Set obFolder = fso.GetFolder(myDir) に書き換えられます。 (seiya)
seiyaさん。
>Set wb = Workbooks.Open(myDir & "\" & fldr.Name & "\" & fn) 先ほど、試してみたのですが、オブジェクトが必要とでてしまったので戻してしまいました。
追記の部分は、 myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用"
ここでしょうか..。
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long, fso, obFolder As Variant
myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用" '処理したいフォルダ名のパス
Set fso = CreateObject("Scripting.FileSystemObject")
Set obFolder = fso.GetFolder(myDir)
For Each fldr In obFolder.SubFolders
MsgBox fldr.Name
fn = Dir(myDir & "\" & fldr.Name & "\" & "*進捗管理仕様書*.xls")
（ぽんぞう）
そうです。 それで動きませんか？ (seiya)
seiyaさん。 Set wb = Workbooks.Open(myDir & "\" & fldr.Name & "\" & fn) ここにfsoやfldrは使わないですよね..。何が足りないのでしょう。 いろいろ編集しているのですが、やはりループの作業が実行されず..。 fnが存在しないという処理になってるんですかね。 （ぽんぞう）
そのエラーが出るところまで走っているということは fn にファイル名が入っているということです。 MsgBoxで確認できますか？ \の位置さえ間違えなければ動くと思いますが？ (seiya)
ファイル名は認識されているのですね..。 Msgでファイル名を表示させようとしましたが、反応せず実行が終了されました。
例えば、 C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用\東京\10.工場出荷\00-12.共通
ここまでがフォルダだとすると Set wb = Workbooks.Open(myDir & "\" & fldr.Name & "\" & fldr.Name & "\" & fldr.Name & fn) とかにならないですよね..？
見落としているのでしょうかorz （ぽんぞう）
まず fn = Dir(myDir & "\" & fldr.Name & "\" & "*進捗管理仕様書*.xls") の下に MsgBox fn として、確認してください。 もし、括弧の中身が間違っていたら空白が戻ります。 fnに何か文字が入力されていたら、ファイルが存在しますので あとはそれを開いてやるだけです。 MsgBox で myDir & "\" & fldr.Name & "\" & fn でフルパスが表示されているか確認してください。 (seiya)
seiyaさん。 ２周とも空白でした...。
次に fn = Dir(myDir & "\" & fldr.Name & "\" & "*進捗管理仕様書*.xls") ~~~~~ を削り、 fn = Dir(myDir & fldr.Name & "\" & "*進捗管理仕様書*.xls") で試したところ、 一回目のループでは一つのブック名が表示され（ただし、フルパスではなくブック名のみ..）、二回目は空白状態です。 そのまま、作業終了...。
やはり私の\の位置が違っているようですね..。 （ぽんぞう）
myDir = "......." 最後の \ は必ず削除して下さい。 そうすれば、 fn = Dir(myDir "\" & fldr.Name & "\" & "*進捗管理仕様書*.xls") でファイル名（.xlsを含んだファイル名のみ）がfnに格納されるはずです。 (seiya) 訂正しました...
myDirは、 myDir = "C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用" なんですよね..。
二回目が空白になってしまってるせいか、全てのブックを格納されることなく終わってしまいます。 （ぽんぞう）
ぼんぞうさん、 ごめんなさいね、ぼんぞうさんのコードをよく読んでいませんでした。 For Each Loop が終了してからDo Loop が始まっているのでそうなります。 For Each Loop の中に Do Loop を入れてやらないといけません。
For Each fldr In obFolder.SubFolders
fn = Dir(....)
Do While fn <> ""
一連のコード
fn = Dir()
Loop
Next
のような形にならないといけません。 (seiya)
seiyaさん。 ごちゃごちゃ書いてしまって混乱しちゃいますよね..すみません。
For Each Loopの編集したところ、動きがみられました♪ありがとうございます（涙）
アプリ進捗資料用のフォルダに直に入っているファイル１つ（集計はファイル全部行っていたのにリストには挙がらず）だけは認識し、計算が行われました。 他にもファイルがあるのに、なぜひとつだけなのでしょうか..。 そのファイルをなくしてみたら、次にフォルダの数だけループされ、Msgにはパスはなく空白になってます。 （ぽんぞう）
ぼんぞうさん、 もう一度コードを提示していただけませんか？ (seiya)
Private Sub ケース数_集計()
Dim e, wb As Workbook, ws As Worksheet, a(), n As Long
ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にファイル名を作成する
a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数
a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
For Each e In myList
Set wb = Workbooks.Open(e) '変数wbにフォルダ名とファイル名を格納
For Each ws In wb.Sheets
If ws.Range("a4").Value = "生物販" Then 'a4セルに文字列が存在した場合
n = n + 1
With ws.Range("h5", ws.Range("h" & Rows.Count).End(xlUp)) 'h5を基点とする
a(n, 1) = e '対象となったフォルダ・ファイル名
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'hから12列目のt列（ケース数にあたる）の集計
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(1, 1)), "") 'ケース数がない場合は、i列の文字列（空白以外）をカウントする
a(n, 4) = SumIfIf(.Offset(, 5), .Offset(, 12), "合格") 'm列の合格数
End With
End If
Next
wb.Close False '保存せずにブックを閉じる
Next
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理 <-現在は、ここでアプリケーション・オブジェクト定義のエラーとなってます。
End Sub
です。
一段下の１フォルダの中のファイルだけは、認識していました。けれど、転記されず..（悩） （ぽんぞう）
コード変更してみましたので確認してください。 (seiya)
seiyaさん。 修正ありがとうございます。変更しました♪
1段目：アプリ進捗資料用（フォルダ）→2段目：東京（フォルダ）・大阪（フォルダ）→3段目：７つのフォルダ+9つのファイル→4段目：9つのフォルダ…… ~~~~~~~~~~~~~~~ この７つのフォルダにもまだフォルダがあるのですが、現段階のコードのままですと、2段目の東京のフォルダの中の3段目に入っているファイルだけ
が集計されて、9つのみのリストが挙がってきました..。
もうちょっと調べてみますorz （ぽんぞう）
SubFolderのSubFolerですか？ (seiya)
seiyaさん。 SubFolderのSubFolerのSubFolderということもあると思います..。 分類毎によって、フォルダの階層が異なっているので。
席を外さなければならないので、お返事遅くなってしまったらすみませんorz （ぽんぞう）
無制限の階層を検索する方法は知りません。 Application.FileSearch との併用になると思いますが... (seiya)
参考： FileSystemObject(FSO)を使って、配下の全フォルダも探索する方法です http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html (tomo)
なるほど、再帰処理ですね。 返ってくるPathを配列に取得してやればループできそう。 (seiya)
tomoさん、seiyaさん。 ありがとうございます。 階層の検索にも限度がありますよね...。
上記参考を元に編集してみます。 できなくはなさそうですかね。
せめて２階層くらいまで検索できると簡潔化になるのですが..。 頑張ります(;´Д`A （ぽんぞう）
ぼんぞうさん、 1) 目当てのBookをすべて検索して配列に入れる。 2) 1) からBookをOpenして処理をする。 という具合にすれば楽になると思いますよ。 (seiya)
seiyaさん。 なるほど..。 これは一度、フォルダの配下全体を検索し一覧にしてから その対象bookの処理が実行されるような感じなのでしょうか。 （ぽんぞう）
とりあえず、すべてのフォルダが列記されるか確認してください。
Private myList() Private n As Long
Sub SearchDir()
Call ListAllBooks("c:\MyDoments and Settings\ponzou\デスクトップ\アプリ進捗資料用")
ケース数_集計
End Sub
Private Sub ListAllBooks(myFolder)
Dim fso As Object, fldr As Object, myFldrs As Object, myBooks As Object
bn = "*進捗管理仕様書*"
Set fso = CreateObject("Scripting.FileSystemObject")
Set myBooks = fso.GetFolder(myFolder).Files
Set myFldrs = fso.GetFolder(myFolder).SubFolders
For Each myBook in myBooks
If myBook.Name Like bn Then
n = n + 1
ReDim Preserve myList(1 To n)
myList(n) = myFolder & "\" & myBook.Name
End If
Next
For Each fldr In myFldrs
ListAllBooks myFolder & "\" & fldr.Name
Next
End Sub
(seiya)
seiyaさん。 ありがとうございます。
ReDim Preserve myList(1 To n)で変数定義を求められてしまっているのですが Option Explicitを使えばいいのでしょうか..。 （ぽんぞう）
あれ？ 一番上に Private myList() がありますよね？ (seiya)
入力してます..。
Private myList()
−−−−−−−−−−
Sub SearchDir()
Call ListAllBooks("c:\MyDocuments and Settings\ponzou\デスクトップ\アプリ進捗資料用")
End Sub −−−−−−−−−− Private Sub ListAllBooks(myFolder) Dim fso As Object, fldr As Object, myFldrs As Object, n As Long ： ：
こんな感じになってます。
あ.. Sub ケース数_集計()の上でしたか..すみませんorz 最高表示は５行なのですね.. msgにて５ファイルが表示され動いていることを確認しました。 （ぽんぞう）
あっ、今あるコードの上に貼り付けてください。 Private myList() がページの一番上に来るように... (seiya)
seiyaさん。 n もモジュールレベル変数とすべきでは？ (ROUGE)
ROUGEさん、 そのとおりですね！ 変更しました (seiya)
mid関数にLengthは指定しなければならないわけではないのでしょうか。 型が一致しないようなので..。 （ぽんぞう）
ぼんぞうさん、 ちょっと目を離している間にコードが変わっていますので、もう一度 コピーして確認してください。 (seiya)
seiyaさん。 MsgBox Join(Split(Mid(myList, 3), ",,"), vbLf) なのですが、Mid()を特に変更することはないですよね..？ （ぽんぞう）
いけね, その部分忘れてました... コード変更しました。
MsgBox Join(myList, vbLf) (seiya)
おお。フォルダ名らしきものがずらりとMsgに表示されているようです♪ ここからフォルダ内の対象xlsの処理をしていけばいいのですね..。 （ぽんぞう）
ちょって待ってください。 表示された４，５行分をアップしていただけませんか？ (seiya)
seiyaさん。 （アプリ進捗資料用） 東京 −−−−−−− <-フォルダ配下 05.製造管理↓ −−−−−−− 00.製造管理マスタ↓ −−−−−−− T00000000-製造***** ： −−−−−−− 01.部材出庫↓ −−−−−−− old −−−−−−− 05.13.設備管理↓ −−−−−−− backup old
： ：
ツリー型にしてますが、このように名前順にフォルダの名前が表示されてました。 50項目ほどです。 （ぽんぞう）
コード変更しました。 Book名のリストになりませんか？ (seiya)
seiyaさん。
Forに対するNextを一行追加しましたが、
For Each myBook In myBooks
If myBook.Name Like bn Then
n = n + 1
ReDim Preserve myList(1 To n)
myList(n) = myFolder & "\" & myBook.Name
End If
Next <-ここ
For Each fldr In myFldrs
ListAllBooks myFolder & "\" & fldr.Name
Next
book名を含むフルパスが表示されました！ （ぽんぞう）
それで完成です。 myList からループしてやればよいだけです。 (seiya)
ケース数集計Sub SearchDirSub を変更しましたので確認してください (seiya)
seiyaさん。 前回のコードにmyListを呼び返して処理を実行すればいいのですね。
長々とご教授していただき、ほんとにありがとうございました！ FSOは今後も長い付き合いになりそうです...ｗ （ぽんぞう）
こちらでテスト出来ないので時間がかかってしまいましたが Bugがでたらご連絡ください。 (seiya)
seiyaさん。 初めに無制限階層とお話をするべきでした。うまく表現できずお手数おかけしましたorz
Set wb = Workbooks.Open(e) について、"が見つからないとでてしまいました。 Do〜Loopさせたほうがいいのでしょうか。 （ぽんぞう）
Set wb = workbooks.Open(e & ".xls") に変更してみて下さい。 (seiya)
seiyaさん。 .xlsが見つからない と表示されます。
（ぽんぞう）
Workbook.Open(e) の前に一行挿入 MsgBox e で確認してください。 (seiya)
eが空白になってました...。 Private Sub ケース数_集計()をCallで返さなければ、book名がmsgに表示されてはいるので..。 （ぽんぞう）
Sub SearchDir() から実行していますよね？ (seiya)
はい。SearchDirから実行してます..。 Private Sub ListAllBooks(myFolder)では正常に動いています。 （ぽんぞう）
変ですね-- Module内でGlobalにしてあるので、問題ないはずですが...
Private myList() Private n As Long
Sub SearchDir() . End Sub
Private ListAllBooks(myFolder) . End Sub
Private ケース数_集計() . End Sub のようになっていますよね？ (seiya)
そのようになってます..。 Private ケース数_集計() を呼び返すと、e値が空白になり、SearchDirのみだと、book名が存在しています..。 （ぽんぞう）
ああ..seiyaさん。 動いているかもです！ コードをもう一度コピペしてみました..。すみませんorz （ぽんぞう）
度々失礼します..。 確認したいことがあるのですが、 パスをブック名にする場合は、f.Nameを使用するよりmyListで変更するべきでしょうか。 If e.Type Like "*進捗管理仕様書*" Then ： a(n, 1) = e.Name としてみても、ブック名が表示できませんでした。 （ぽんぞう）
e.Type とか f.Name とかわかりません。 (seiya)
seiyaさん。 いろいろとありがとうございましたorz スマートなコードで憧れます..。 a(n, 1) = wb.Nameに変更して、成功しました..すみません。 （ぽんぞう）
動いたのでしょうか？ wb.Name でどの階層にあるファイルか判別出来ればよいのですが e または wb.FullName で FullPath が表示されるはずですので いろいろ試してください。 (seiya)
seiyaさん。 ListAllBooksに固定したフォルダに突っ込んだ全フォルダが対象となっているようです..。 二通り作ってみまして、 フルパス（C:\Documents and Settings\ponzou\デスクトップ\アプリ進捗資料用\****\****\****進捗管理仕様書.xls)のパターンと ブック名のみ（****進捗管理仕様書.xls）のパターン を作成しました。 階層別に検索するにはフルパスが便利ですよね。 完成してめちゃくちゃ感動しています..貴重なお時間ありがとうございます。 （ぽんぞう）
>ListAllBooksに固定したフォルダに突っ込んだ全フォルダが対象.... ご要望がそのようなので、そのように作成したつもりです。 その中から、対象ファイル名のみを抽出していると思いますが？ こちらでは、 e がどのような形で返されているのかわかりませんけど... (seiya)
seiyaさん。 >ListAllBooksに固定したフォルダに突っ込んだ全フォルダが対象 希望通りですです！あってます。 集計用のフォルダとしているので、分類別にこのフォルダの中へフォルダ毎移動しては集計。削除しては、また別のフォルダを移動して集計。という感じで作業してるので。
*進捗管理仕様書*の対象だけ抽出されていますのでこれも大丈夫です。 eは、階層全てのpathが表示されリストに記入されていました。 （ぽんぞう）
とりあえず、ほっと一息ですね。 e.Type, f.Name の件わかりました。 参考リンク先で見たのですね？ 私は「再帰」という考え方だけ参考にしましたので あちらのコード自体は殆ど見ていません。 (seiya)
seiyaさん。 一息以上に満足すぎて申し訳ない気持ちでいっぱいです..orz 物覚えが悪い私に何日もお付き合いして頂いて..。 まだまだ過去ログや書籍を頼る毎日ですが(;´Д`A ``` F8で一行ずつ処理の確認するというのは、 実はseiyaさんの過去ログで覚えたものです..ｗ 私も実際e.Typeは使用する頻度はなかったのですが、片っ端からコードをいじってみました。 壊れてしまったら、そのときはお願いします..ｗ しないようには頑張ります..orz （ぽんぞう）
こんにちは。 使用して気づいた点が一件ありまして、再度質問させてください。
リストが掲示される際に、重複してループされているようなのですが どのように修正すればよろしいのでしょうか。
実際、フォルダ内の集計を一回行い、 従来ならc:\MyDocuments and Settings\ponzou\デスクトップ\アプリ進捗資料用にあるフォルダ内のブック４つについて検索され、処理された状態で
[a] [b] [c] [d] [1] ブックリスト ケース数 行数 合格件数 [2] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!輸出出荷指図書 20 20 [3] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!検索条件確認項目 0 0 0 [4] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!輸出指図日別一覧表 20 20 [5] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!検索条件確認項目 0 0 0
こうなるはずなのですが、２回SearchDir()を実行すると、
[a] [b] [c] [d] [1] ブックリスト ケース数 行数 合格件数 [2] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!輸出出荷指図書 20 20 [3] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!検索条件確認項目 0 0 0 [4] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!輸出指図日別一覧表 20 20 [5] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!検索条件確認項目 0 0 0 [6] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!輸出出荷指図書 20 20 [7] TK0001-進捗管理仕様書-R*****（輸出出荷指図書）.xls!検索条件確認項目 0 0 0 [8] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!輸出指図日別一覧表 20 20 [9] TK0001-進捗管理仕様書-R*****（輸出指図日別一覧表）.xls!検索条件確認項目 0 0 0
と、前回の処理が消去されず実行した回数の分だけリストに挙がってしまいます。
また、別のフォルダを実行する際に、集計済みのフォルダを削除するとエラー表示がされてしまいます。
setした情報を解除しなければならないのでしょうか...。
（ぽんぞう）
1)
ThisWorkbook.Sheets(1).Range("a1").Resize(n,4).Value = a
を
With ThisWorkbook.Sheets(1).Range("a1")
.CurrentRegion.ClearContents
.Resize(n,4).Value = a
End With
2) 意味がわかりません。 (seiya)
seiyaさん。 ありがとうございます。 修正してみましたが、同じ現象でした...。 一度、ブック（リスト用の）を閉じると１回分のリストが挙がりますが、 続けて２回実行すると、やはり２回分が表示されます。
2)についてなのですが、例えば東京のフォルダを集計し終わった際に、 次は大阪だけを集計したい場合 東京のフォルダをc:\MyDocuments and Settings\ponzou\デスクトップ\アプリ進捗資料用 から除外します。 そして大阪のフォルダに入れ替え、実行すると 「東京フォルダのファイル名が見つからない...」みたいな実行時エラーがでてしまうのです。
うまく説明できずすみません...。 （ぽんぞう）
1)
A列に追加なら
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(n,4).Value = a
2) >c:\Mydocuments and Settings\ponzou\デスクトップ\アプリ\進捗資料用から"除外"して"大阪"の フォルダに入れ替え、実行すると...
c:\MyDocuments......\アプリ進捗資料用の階層下にあれば、検索するでしょうし、無ければ除外 されると思いますが？ (seiya)
フォルダの分類毎に毎回、リスト内は削除してその分類毎に集計した行を、別シートに転記しているので、最終行に追加はしていないです。
気になる点が、実行時エラーでForループが初期化されていません。とデバックすることがあります。 For Each e In myList <-ここです。
これが重複して作業してしまう原因なのでしょうか。
階層下に置いているのですが、不思議と存在しない扱いされてしまうのです。 （ぽんぞう）
ははーん、
Sub 進捗管理仕様書() . . . . n = 0 End Sub にしてください。 (seiya)
seiyaさん。 Moduleといいますか、プロシージャが分けられてしまって問題ないでしょうか。 PrivateをSubステに変えましたが、初期化されませんでした...。
Sub 進捗管理仕様書_集計()
Dim e, wb As Workbook, ws As Worksheet, a(), n As Long, fName As String
ReDim a(1 To Rows.Count, 1 To 4)
a(1, 1) = "ブックリスト" 'a列にブック・シート名を作成する
a(1, 2) = "ケース数": a(1, 3) = "行数" 'b列にケース数、c列に行数
a(1, 4) = "合格件数" 'd列に合格（文字列）件数
n = 1
For Each e In myList
Set wb = Workbooks.Open(e) '変数wbにフォルダ名とブック名を格納
For Each ws In wb.Sheets
If ws.Range("a4").Value = "生物販" Then 'a4セルに文字列が存在した場合
n = n + 1
With ws.Range("h5", ws.Range("h" & Rows.Count).End(xlUp)) 'h5を基点とする
a(n, 1) = wb.Name & "!" & ws.Name '対象となったブック・シート名
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'hから12列目のt列（ケース数にあたる）の集計
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(1, 1)), "") 'ケース数がない場合は、i列の文字列（空白以外）をカウントする
a(n, 4) = SumIfIf(.Offset(, 5), .Offset(, 12), "合格") 'm列の合格数
End With
End If
Next
wb.Close False '保存せずにブックを閉じる
Next
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 4).Value = a '集計ブックの数値処理
n = 0
End Sub
（ぽんぞう）
このSubをPrivateにしたのは、単独では用を足さないのです。 何をしたいのですか？ (seiya)
callで呼び返すのに、Privateでないと動かないのかと勘違いしていました..。すみません。 集計には問題ないのですが、 1)現状のコードで実行する回数の分だけ同じデータが転記されてしまう。 2)Forループの抜け出しが未だにうまくいきません。 代入演算でn=0としているんですよね..。
フォルダ内は、分類によってフォルダを入れ替えし、集計が終わったら分類別のシートに転記 転記が終わったら行を削除、次のフォルダをアプリ進捗資料用に移動...の繰り返しです。 その際に起こるエラーが上記に挙げた状態です。 （ぽんぞう）
フォルダごとに集計したいのですか？ とにかく、その状況でPrivate Sub を単体で実行すると必ずエラーになります。 (seiya)
seiyaさん。 フォルダ毎には集計されています。 各エリア毎のフォルダを集計専用のフォルダ「アプリ進捗資料用」に随時入れ替えをし その階層下のフォルダがリストアップされています。 終わったらフォルダを削除し、次のエリアのフォルダに入れ替え。
Private Sub 進捗管理仕様書_集計() で使用していたときは、Sub SearchDir()で実行していました。 callでPrivateSubのPrivate ListAllBooks(myFolder)とPrivate Sub 進捗管理仕様書_集計() が実行されます。
Forループを強制的に初期化、Exit Forなどにするべきなのでしょうか。 1)フォルダを入れ替え、実行するとForループが初期化されません。とでます。 2)同じフォルダ内で実行すると、上書きされるのではなく、重複されてしまう。 ３回実行したら、同じデータが３段階になって転記されている。
この２点が問題になっているようで...。 私も調べてはいるものの、修正しても解決できなかったのでorz （ぽんぞう）
1) n = 0 は入っていますか？
2) 同じフォルダ内で実行すると... の意味がわかりません。
もし、下に追記されていくという意味でしたら、コードを元に戻してください。
(seiya)
seiyaさん。 1)n = 0はEnd Subの直上に入っています。 2)フォルダを入れ替えず、Sub SearchDir()を何度も実行すると、 下に追記され50行が100行、100行が150行とダブって一覧化されてしまいます。 >もし、下に追記されていくという意味でしたら、コードを元に戻してください。 そのような状態ですね..。
そしてフォルダを違うものに入れ替えると、Forループが初期化…とエラーが生じます。 （ぽんぞう）
1) は Private ....集計() を元に戻す。（n = 0 は必ず挿入)
2) はフォルダを削除してから、SearchDir を実行したときにエラーですか？
考えられないのですが？
(seiya)
seiyaさん。 1)は直して再度実行しています。 2)実行はSearchDirのみです..。
エラーがでるのは、 東京フォルダを削除し、大阪フォルダを「アプリ進捗資料用」に移動し、 進捗管理仕様書のブックから実行した際に、 1)東京フォルダ\***\***のファイルが見つからない。 デバッグを終了し、再度実行すると、今度は 2)Forループが初期化されていません。 と続行不可能...。 試しに、東京フォルダを戻し、大阪を外し実行すると、 集計されるが追記され多重にリストアップされてしまう。 という状況です..。
（ぽんぞう）
それでは Sub SearchDir() n = 0 . . End Sub としてみてください。 nが0になれば ReDim Preserve myList(1 To n) でmyListが初期化されるはずです。 (seiya)
seiyaさん。 Sub SearchDir()の直下にn = 0を代入したところ、初期化されました！ ありがとうございますorz フォルダ変更の際も正常に動きました..。 もしかしたら、空フォルダの場合でエラーが生じていたのかもしれません...。 いつもお騒がせしてすみません。 助かりました。 （ぽんぞう）
n=0 にしておかないと、myList が初期化されずに、前回実行時のブック名が 格納されたままになるので、削除されてしまったフォルダのファイルには アクセスできなかったわけです。 (seiya)
seiyaさん。 なるほど..。n = 1の状態のままだったために、 1ずつ追記されてしまってたわけですか..。 よくコードを読み直さなければなりませんね..orz （ぽんぞう）
n=0 を外して、Step debug して n を追いかけてください。 失礼ですが、ぼんぞうさんは「想像」している部分が多いように 思われます。 実際に変数を追いかければ、どのようなことが発生しているか 一目瞭然です。 (seiya)
seiyaさん。 ごもっともです..orz確かに思い込み等が多いです..。 エラーがでると、あたふたと考えていくうちに これか！こっちか！と冷静に判断できなくなる傾向にあります..。 一行ずつ追いかけてみます。 （ぽんぞう）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.