質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1916閲覧

【ExcelVBA】集計対象のファイルを重複なく一覧表にしたい

MitsuhiroN

総合スコア12

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/10/18 05:25

編集2018/10/18 05:27

前提・実現したいこと

 Excel VBAで、複数の階層に格納された集計対象となるファイルを、重複したファイルは更新日時が最新のものに置き換え、ファイル名・パス名・フルパスを項目名にしたテーブルにしたいと考えております。

その為に、FileSystemObjectで取得した全FileオブジェクトをCollectionに格納し、そのCollection内で重複したファイルの内、古い方を除外して出力、という流れで考えました。

複数のチームが記入した記録表(Excel)を以下の階層構造で格納しています。
<チーム1> — <内部R/顧客R> —<機能A/機能B>-<指摘依頼中/完了etc・・・> — *.xlsx
<チーム2>・・・

チームごとに内部Rフォルダ・顧客Rフォルダ、それぞれの配下に機能ごとのフォルダ、その下にレビューの進捗度で更にフォルダ分け(依頼中・完了等)して、最後の階層に該当記録表を格納しています。
大まかにこのルールで格納されているのですが、同じファイルが違う進捗フォルダに格納されていることがあり、
⇒ Aファイルが〈指摘依頼中フォルダ〉と〈完了フォルダ〉双方に同名で格納。更新日時は完了フォルダの方が新しい。

重複したファイル名は更新日時の新しい方に上書きして取得したいです。
また、ほぼ進捗自体が完了した機能に関しては進捗分けもしておらず、直にファイルが置かれていることもあります。

発生している問題

重複の上書きがうまくできません。
全ファイルを一度Collectionに格納してから比較、という流れにしたいのですが、フォルダ単位で比較を実施してしまうが為に削除が実施できていないようです。

該当のソースコード

Excel

1Public Sub GetSubFolder(ByRef teams_basefolder As String) 2 'teams_basefolderに各チームの内部/顧客Rまでのフォルダパスを受け取る 3Dim fso As New FileSystemObject 4Set fso = New FileSystemObject 5 6Dim firstfolder As folder 7Dim firstSubfolders As folders 8Dim firstSubfolder As folder 9Dim firstfiles As files 10Dim firstfile As file 11 12Dim folder As folder 13Dim folders As folders 14Dim fls As files 15Dim fl As file 16Dim fileCollection As New Collection 17 18Set firstfolder = fso.GetFolder(teams_basefolder) 19Set firstfiles = firstfolder.files 20For Each firstfile In firstfiles 21 If firstfile.Name Like "内Rev記録*.xlsx" _ 22 And firstfile.Name Like "Rev記録*.xlsx" _ 23 And firstfile.Name <> "内Rev記録_設計書名.xlsx" Then 24  '記録表のファイル名のフォーマット。テンプレート用のファイルも一緒に格納されているため除外 25 With fileCollection 26 .Add firstfile 27 End With 28 End If 29Next 30 31Set firstSubfolders = firstfolder.SubFolders 32 33For Each firstSubfolder In firstSubfolders 34 Set fls = firstSubfolder.files 35 36 For Each fl In fls 37 If fl.Name Like "内Rev記録*.xlsx" _ 38 Or fl.Name Like "Rev記録*.xlsx" Then 39 With fileCollection 40 .Add fl 41 End With 42 End If 43 Next 44 45Next 46 For Each fl In fls 47 If fl.Name Like "内Rev記録*.xlsx" Or fl.Name Like "Rev記録*.xlsx" Or _ 48 fl.Name <> "内Rev記録_設計書名.xlsx" Then 49 With fileCollection 50 .Add fl 51 End With 52 End If 53 Next 54 55 For Each folder In fso.GetFolder(teams_basefolder).SubFolders 56 If folder.Name Like "*old*" Then GoTo goNext 57 Call GetSubFolder(teams_basefolder & "\" & folder.Name) 58goNext: 59 Next 60 61Dim col As New Collection 62Set col = compareBothCollection(flCol) 63Call pasteSpecFiles(col) 64 65 66Set fso = Nothing 67Set basefolder = Nothing 68Set fls = Nothing 69Set flCol = Nothing 70Set col = Nothing 71 72End Sub 73 74 75Private Sub pasteSpecFiles(ByRef col_file As Collection) 76Dim startLine As Long 77Dim F As file 78 79With allFiles 80 startLine = .Cells(.Rows.count, allFilesSh.絶対パス).End(xlUp).Row 81 82 For i = 1 To col_file.count 83 Set F = col_file.Item(i) 84 .Cells(startLine + i, allFilesSh.絶対パス).Value = F.path 85 .Cells(startLine + i, allFilesSh.フォルダ).Value = F.parentFolder 86 .Cells(startLine + i, allFilesSh.ファイル名).Value = F.Name 87 Set F = Nothing 88 Next 89End With 90End Sub 91 92 93 94Private Function compareBothCollection(ByRef colfiles As Collection) As Collection 95 96Dim bufColfile As New Collection 97Dim fl As file 98Dim fl2 As file 99Dim i As Long, j As Long 100 101Set bufColfile = colfiles 102 103For i = 1 To colfiles.count 104 For j = 1 To bufColfile.count 105 Set fl = colfiles(i) 106 Set fl2 = bufColfile(j) 107 108 If fl.Name = fl2.Name Then 109 If fl.DateLastModified < fl2.DateLastModified Then 110 colfiles.Remove (i) 111 Else: GoTo Skip 112 End If 113 Else: GoTo Skip 114 End If 115Skip: 116 Set fi = Nothing 117 Set fl2 = Nothing 118 Next 119Next 120Set compareBothCollection = colfiles 121 122End Function 123 124 125 126 127 128

どういう処理の流れにすればよいかがわからず、質問させていただきました。
以上、よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

直接の回答にはなっていませんが。。。

全ファイルを一度Collectionに格納してから比較、という流れにしたいのですが

そもそもこれはどういった理由からなのでしょうか?

もし自分が作るならですが、次のように考えます。

  • CollectionではなくDictionaryを使う
  • Dictionaryはファイル名をキーにする
  • Dictionaryにファイルが存在するかExistsでチェックする
  • 存在していたら更新日付を比較、新しければ同じキーに更新する
  • 存在していなかったらファイル名をキーに新しく登録する
  • 全ファイル終わったら出力

投稿2018/10/18 06:50

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

MitsuhiroN

2018/10/18 07:39

いえ、方法としてCollectionにこだわっているわけではないです。 試行錯誤で思いついた方法なので。ただ、最終的にフルパスとフォルダとファイル名とをテーブルに貼り付けすることを考えると、できればFileオブジェクトとして終始扱いたいなと思いまして、それだったらCollectionかなと。 Dictionaryの場合itemにオブジェクトを格納することが可能だったか・・と思ったもので、現状Collectionで考えています。
ttyp03

2018/10/18 07:47

Dictionaryにもオブジェクトは格納できます。 手前味噌ですが、過去質問でDictionaryを使った回答をしていますので参考まで。 https://teratail.com/questions/149008 この質問の回答では多重Dictionaryですが、fileオブジェクトも格納可能と思います。
MitsuhiroN

2018/10/18 22:46

お二方ありがとうございます! オブジェクトが格納可能なのが確認できました!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問