解決済み

複数のフォルダに保存されているファイルの検索

  • 困ってます
  • 質問No.9617120
  • 閲覧数123
  • ありがとう数6
  • 気になる数0
  • 回答数8
  • コメント数0

お礼率 68% (371/538)

いつもお世話になっております。
ややこしい要求で、うまく説明できるか不安要素が有るのですが。

多くの製品に関する情報が品種別フォルダに格納されています。
「製品」というフォルダの中に「アルファベット(A~Z)」「50音(あ~わ)」「数字(0-9)」のフォルダに分かれています。
各製品のフォルダの中は色んな情報がフォルダに分類されて保存されています。

品名別(例えば「A」)フォルダの中に「ABC123」という製品名のフォルダがあり、その中に「成績表」というフォルダがあります。
その中には、LOTごとの品質成績表がワード、もしくはPDFで保存されているのですが、全製品のワードファイルとPDFファイルの作成日を一覧にする方法はないでしょうか?

保存されている成績表の枚数が製品によって大きく違うので直近の5枚とか、過去2年間のファイルの作成日のどちらかが分かれば非常に助かるのですが。

質問者が選んだベストアンサー

  • 回答No.8

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
乗りかかった船なので、
>フォルダの文言が「成績表」「成績書」
>「試験成績表」等有ることも分かりました。
に対応し、
更にアルファベットの大文字小文字の区別もしないようにしてみました。


Option Explicit

Const tgDir = "\\Srv01\・・・\部\課\チーム\☆成績書"

'//--------------------
Sub Sample()
 
 Dim startCell As Range
 Dim maxRow As Long
 Dim maxCol As Long

 Set startCell = Cells(2, 3)  'このセルから出力し始める
 startCell.Select

 '出力先シートをクリア
 maxRow = startCell.SpecialCells(xlLastCell).Row
 maxCol = startCell.SpecialCells(xlLastCell).Column
 Range(startCell, Cells(maxRow, maxCol)).ClearContents
 
 Call getFileList(tgDir, "1.成績表")
 Call getFileList(tgDir, "1.成績書")
 Call getFileList(tgDir, "1.試験成績表")

End Sub

'//--------------------
Sub getFileList(searchPath As String, PicDir As String)

 Dim FSO As New FileSystemObject
 Dim objFiles As File
 Dim objFolders As Folder
 Dim separateNum As Long

 'サブフォルダ取得
 For Each objFolders In FSO.GetFolder(searchPath).SubFolders
  Call getFileList(objFolders.Path, PicDir)
 Next

 'ファイル名の取得
 For Each objFiles In FSO.GetFolder(searchPath).Files
   separateNum = InStrRev(objFiles.Path, "\")
   If StrConv(StrConv(Right(Left(objFiles.Path, separateNum - 1), _
     Len(PicDir)), vbWide), vbUpperCase) = _
     StrConv(StrConv(PicDir, vbWide), vbUpperCase) Then
   'セルにパスとファイル名を書き込む
   ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
   ActiveCell.Offset(0, 1).Value = _
     Right(objFiles.Path, Len(objFiles.Path) - separateNum)
   ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
   ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
   ActiveCell.Offset(1, 0).Select
  End If
 Next

End Sub
お礼コメント
akira0723

お礼率 68% (371/538)

ひえ~ まさかの改良版!!
昨日までの結果を昨夜確認して、朝一でBA選定して閉め切ろうと思って今開けてみたら改良版が入っていました。

結局何度も複数のコードを作ってもらうことになってしまい申し訳ありませんでした。
せめて最初から「最後の条件まで」を提示出来ればよかったのですが、無知故いつもの通り追加の質問になってしまい申し訳ありませんでした。

このコードは未確認ですが、間違いないと自信が有りますので???一旦締め切らせていただきます。
万が一の時は別の質問として投稿しますのその節にもよろしく願いします。
投稿日時 - 2019-05-23 09:20:41

その他の回答 (全7件)

  • 回答No.7

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
'ファイル名の取得
 For Each objFiles In FSO.GetFolder(searchPath).Files
  separateNum = InStrRev(objFiles.Path, "\")
  If Right(Left(objFiles.Path, separateNum - 1), Len(PicDir)) = PicDir Then
   'セルにパスとファイル名を書き込む
   ActiveCell.Value = Left(objFiles.Path, separateNum - 1)

↑を↓に書き換えてください。

'ファイル名の取得
 For Each objFiles In FSO.GetFolder(searchPath).Files
   separateNum = InStrRev(objFiles.Path, "\")
   if StrConv(Right(Left(objFiles.Path, separateNum - 1), Len(PicDir)), vbWide) = _
     StrConv(PicDir, vbWide) then
   'セルにパスとファイル名を書き込む
   ActiveCell.Value = Left(objFiles.Path, separateNum - 1)


そうすることで、
半角、全角の区別なく指定のフォルダーを対象にできます。
補足コメント
akira0723

お礼率 68% (371/538)

夜に動くことを確認し、朝一で実フォルダで試しました。
抽出数が大きく増えたので間違いないと思います。
但し、昨日のデータ検証で、フォルダの文言が「成績表」「成績書」「試験成績表」等有ることも分かりました。

これまでは「A」「B」「あ」「い」・・・ファルダを機械的に処理していたので気付きませんでした。
(各フォルダをDOS画面で処理して、50音、アルファベット、数字の各フォルダのファイル情報をTEXTで取得し、その約80個のエクセルファイルをDOS画面で1枚にまとめる)

今回のご回答で全角、半角が区別なく抽出できるので、各文言ごとにファイルを作っておけば数枚(3-5?枚程度)のエクセルファイルにできますのでこれで十分でとりあえずこれで作業開始したいと考えています。

もし、本質的な問題が発生したときには見放さずに何卒よろしくお願い致します。
投稿日時 - 2019-05-22 09:23:49
お礼コメント
akira0723

お礼率 68% (371/538)

いつもながらの当方のレベルに合わせたご回答に感謝、感激、感服致します。

今回はあまりにも当方のレベルを超えているため別の問題も認識していますが、上記の方法では膨大な工数がかかっており、そもDOS処理も完全に理解しているわけではないので問題は同じ。

この方法は何せエクセルなので当方でもマニュアル化しやすいので、後の人が機械的に処理できるように整備して、予備ファイル(動作確認ファイル)も残しておきます。

本当にありがとうございました。
投稿日時 - 2019-05-22 10:02:38
  • 回答No.6

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
>3つ下の階層にある「1.成績表」のフォルダ
『3つ下』という条件ではちょっと面倒なので
指定のフォルダー:"\\Srv01\・・・\部\課\チーム\☆成績書"
この下階層から"1.成績表"のフォルダーを見つけ
リストアップするようにしてみました。

Option Explicit

Const tgDir = "\\Srv01\・・・\部\課\チーム\☆成績書"
Const PicDir = "1.成績表"

Sub Sample()
 Call setFileList(tgDir)
End Sub


'//--------------------
Sub setFileList(searchPath)
 Dim startCell As Range
 Dim maxRow As Long
 Dim maxCol As Long

 Set startCell = Cells(5, 2) 'このセルから出力し始める
 startCell.Select
 
  'シートをいったんクリア
 maxRow = startCell.SpecialCells(xlLastCell).Row
 maxCol = startCell.SpecialCells(xlLastCell).Column
 Range(startCell, Cells(maxRow, maxCol)).ClearContents
 
 Call getFileList(searchPath)
 startCell.Select
End Sub

'//--------------------
Sub getFileList(searchPath)

 Dim FSO As New FileSystemObject
 Dim objFiles As File
 Dim objFolders As Folder
 Dim separateNum As Long

 'サブフォルダ取得
 For Each objFolders In FSO.GetFolder(searchPath).SubFolders
  Call getFileList(objFolders.Path)
 Next
 
'ファイル名の取得
 For Each objFiles In FSO.GetFolder(searchPath).Files
  separateNum = InStrRev(objFiles.Path, "\")
  If Right(Left(objFiles.Path, separateNum - 1), Len(PicDir)) = PicDir Then
   'セルにパスとファイル名を書き込む
   ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
   ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
   ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
   ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
   ActiveCell.Offset(1, 0).Select
  End If
 Next
 
End Sub
補足コメント
akira0723

お礼率 68% (371/538)

すごいです!!
朝一で確認してみたら、一発で目的の結果が得られました。

最初は黒画面になってしまってヒヤリとしましたが待つこと数十秒でいきなり結果が表示されました。

昨日の結果とかなり抽出数が違っているのですが、これはフォルダ構成のためだと思いますので、これから詳細を検証しフォルダ構成の改善を試みてみます。

「ノイズあり/漏れなし」、と「ノイズ無し/漏れあり」のどちらでも出来るので一旦締め切らせてもらいます。(再度の節はよろしくお願いします)
投稿日時 - 2019-05-21 08:29:57
お礼コメント
akira0723

お礼率 68% (371/538)

一旦作業を中断して、早々にお礼とBSで閉め切ろうとしてかなりデータ数が違っているので少し検証してみたら、「1.成績表」の「1」と「.」が半角、全角が混在していることが判明しました。

当方が着任後は英数カタカナ()は半角と決めたのですが昔のフォルダ+ウッカリも有るようです。(複数の人が作業するのでこの程度のミスは致し方なし)

お礼を書きかけて追加の質問になってしまうのですが、
>Const PicDir = "1.成績表"
これを複数個指定することは出来ないでしょうか?
他にも極少数「1.試験成績表」も有りました。


大きく変わるようなら、前回のリストをフィルタしますのであまりお手数をかけていただかなくて結構です。

どなたかが言ってましたが、「無料の範囲ではない」こと、承知で申し訳なく・・・・
投稿日時 - 2019-05-21 09:26:59
  • 回答No.5

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
http://blog.jmiri.net/?p=1763
の冒頭で説明している
※メニュー[ツール]→[参照設定]で、「Microsoft Scripting Runtime」にチェックが入っていない場合はチェックしておきましょう。
が必要です。
補足コメント
akira0723

お礼率 68% (371/538)

毎度(複数回)お世話になっております。

先ずは結果報告。
動きました。感動!!!!

但し(がまたまた付き申し訳ありません)最初はデスクトップにあるフォルダで試して感動したのですが、目的のパスで試したら9分間かかりました。
この時間は大した問題ではないのですが、結果が30000行になってしまってこの中から必要なファイルを抽出するのにまたまた「ご相談」になりかねない状況となりました。

ここまで書いて表にフィルタをかけること気付いて試してみたら必要なファイルは1000程度でした。(処理は20秒程度で終わる計算)

そこで厚かましくも追加の質問(要求)ですが、質問に例示のパスの下に製品ごとの例えば「A」のフォルダがあり、その下に「ABC123」という製品フォルダがあり、その下に必ず「品質」、その下に必ず「1.成績表」というフォルダがあります。
つまり質問に例示のフォルダの3つ下の階層にある「1.成績表」のフォルダを指定して(中抜きのパス)での対応は出来ないでしょうか?

"\\Srv01\・・・\部\課\チーム\☆成績書"・・・・”1.成績表”

あまり複雑(当方にはハードルが高い)ようなら上記のご回答で十分ですのでお手数なら本当に結構です。
(1つ1つのフォルダ別に処理していたことを思うとご回答で十分です)
投稿日時 - 2019-05-20 13:55:00
お礼コメント
akira0723

お礼率 68% (371/538)

申し訳ありません。
今早速結果一覧表で作業を開始したところ、最終目的の「1.成績表」フォルの階層は色んな深さが有ること気付きました。
よって質問のファルダの下3つ目ではなく、中抜きのパスでないと駄目なことが分かりました。

いつもながら質問前の状況把握が甘くすみません。
投稿日時 - 2019-05-20 14:25:19
  • 回答No.4

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
以下のコードを標準モジュールに貼り付け
Sub Sample()
を実行することで期待の動きになりませんでしょうか?
エラーならエラーメッセージ詳細を説明してみてください。


Option Explicit

Sub Sample()
Call setFileList("\\Srv01\・・・\部\課\チーム\☆成績書")
End Sub
'//--------------------
Sub setFileList(searchPath)
  Dim startCell As Range
  Dim maxRow As Long
  Dim maxCol As Long

  Set startCell = Cells(5, 2) 'このセルから出力し始める
  startCell.Select
  
  'シートをいったんクリア
  maxRow = startCell.SpecialCells(xlLastCell).Row
  maxCol = startCell.SpecialCells(xlLastCell).Column
  Range(startCell, Cells(maxRow, maxCol)).ClearContents
  
  Call getFileList(searchPath)
  startCell.Select
End Sub

'//--------------------
Sub getFileList(searchPath)

  Dim FSO As New FileSystemObject
  Dim objFiles As File
  Dim objFolders As Folder
  Dim separateNum As Long

  'サブフォルダ取得
  For Each objFolders In FSO.GetFolder(searchPath).SubFolders
    Call getFileList(objFolders.Path)
  Next
  
  'ファイル名の取得
  For Each objFiles In FSO.GetFolder(searchPath).Files
    separateNum = InStrRev(objFiles.Path, "\")
    'セルにパスとファイル名を書き込む
    ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
    ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
    ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
    ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
    ActiveCell.Offset(1, 0).Select
  Next
  
End Sub
補足コメント
akira0723

お礼率 68% (371/538)

お世話になります。
昨夜自宅のPCのローカルファイルのホルダで、今、会社のNET上の実際のホルダで試してみました。

同じ結果で「コンパイルエラー、ユーザ定義型は定義されていません」とメッセージが出ます。

下記の1行目が黄色のハイライトで、2行目は選択された状態(青背景)になります。

Sub getFileList(searchPath)

Dim FSO As New FileSystemObject

お手数をおかけしますが何とかよろしくお願いします。
投稿日時 - 2019-05-20 08:42:50
  • 回答No.3

ベストアンサー率 28% (4478/15941)

Excel(エクセル) カテゴリマスター
(1)VBAとFSOという付属ソフト・機能を使って、やっとやれるかな、という課題です。
(2)会社の中に、VBAができる人はいませんか。
(3) 無料でやりたいとせず、会社の、出入りのソフト業者に、頼むことはできないかな。
(4)出来合いのフリーソフトがあるか探す手もあるが、探すのがむつかしいでしょう。この機能だけの市販ソフトは、売り出しても、買う人はほとんどなく、売り出すはずがない。ファイル管理ソフトという部類のものがあれば、その中に
この機能があるかも。
ーーー
本件は、処理対象は、フォルダが複数であるようだから、フォルダ名をエクセルシートの例えばA列に並べて、それを1つずつ処理する方式になろう。
1つのフォルダだけなら、FSOを使って(For Each )
(WEB記事例)
Dim fso As FileSystemObject
Set fso = New FileSystemObject ' インスタンス化
Dim fl As Folder
Set fl = fso.GetFolder("D:\") ' フォルダを取得
Dim f As File
For Each f In fl.Files ' フォルダ内のファイルを取得
Debug.Print (f.Name) ' ファイルの名前 (Tips.txt) など <--ここはシートのセルに書き出しに変える。次行も同じ。
Debug.Print (f.Path) ' ファイルのパス (D:\Tips.txt) など
Next
' 後始末
Set fso = Nothing
ーー
>ファイルの作成日は
d = f.DateCreated
で採れるだろう。
https://www.tipsfound.com/vba/18013 参照
ーー
>全製品のワードファイルとPDFファイル
は、ファイルの拡張子で篩にかければ仕舞い。
ーー
回答者の中にやってくれる人が出るかも。
小生は、コード作成が面倒なのと、データ実例が手元になく、ファイル実例、フォルダ実例を作るのも面倒なのと、回答者がコード作成下請けとなるので(本来有料の仕事レベル)、コード作成はしない。
お礼コメント
akira0723

お礼率 68% (371/538)

ご回答ありがとうございます。
仰る通り!

アドバイス部分は理解はできても当方は具体的に使えるレベルではないのが悩みです。
投稿日時 - 2019-05-17 12:55:19
  • 回答No.2

ベストアンサー率 59% (196/330)

Excel(エクセル) カテゴリマスター
VBAでよければ
http://blog.jmiri.net/?p=1763
にコードがあります。

期待とレイアウトが違うとかがあれば指摘してください。
可能なかぎり、紹介したコードを直してポストします。
補足コメント
akira0723

お礼率 68% (371/538)

いつもお世話になっております。
早々のご回答ありがとうございます。

朝よりコードを標準モジュールにコピペして、何度かトライしているのですが、VBEのツールバーから実行(R)すると空白のマクロの窓が表示されるだけで、アクティブボタンは「キャンセル」のみでこれ以上進めず。

ダメ元でNETの通り「ボタン」を作ってみましたが、マクロの登録画面に何も出てこないので登録できず。

最後に無駄なあがきと思いつつ、Sheet1にコードを張り付けて「マクロ名」を変えてみたりして、登録してみたのですが当然”×”でした。

誠にお恥ずかしながら、何か抜けていると思うので、お手数をおかけしましが、そこからご教示お願い致します。

尚、フォルダーはNET上の深いところにありますが、入力するフォルダのパスは、そのフォルダを「Shift+右クリック」で(パスのコピー(A))で得られる(\\aaa\bbb\ccc\ddd・・)パスでいいのですよね?

"\\Srv01\・・・\部\課\チーム\☆成績書

このフォルダの下に品名毎の「数字」「アルファベット」「50音」のフォルダがあって、その下の階層に各LOTの「成績表」がワードとPDFファイルで保存されている状況です。

いつもながら何度もお手数をかけてしまいますが、定期的な作業なので何とか少しでも簡略化したく、よろしくお願い致します。
投稿日時 - 2019-05-17 12:46:44
  • 回答No.1

ベストアンサー率 73% (804/1095)

他カテゴリのカテゴリマスター
要は、「特定フォルダ以下のファイルリスト」を
作成できれば良いのかと解釈しました。
--
りすてぃんぐ♪
https://www.vector.co.jp/soft/win95/util/se216097.html
--
と言うソフトがあります。
かつてはファイルリスト作成機というソフトがありましたが、
開発を終了してしまいましたので、Windows10対応はこれくらいかと。
お礼コメント
akira0723

お礼率 68% (371/538)

早々のご回答ありがとうございました。
ダウンロードしようとしたのですが「管理者」によって制限されているとのことで不可でした。

2か所から試みたのですが同じ結果でした。
残念!
投稿日時 - 2019-05-17 12:50:51
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

ピックアップ

ページ先頭へ