[[20180601003720]]　『複数の指定したフォルダの中身をチェックしたい』（ウララ）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『複数の指定したフォルダの中身をチェックしたい』（ウララ）

はじめまして
何から相談して良いか分からないんですが
四月から塾で事務アルバイトをしており生徒の成績などチェックをしています
講師の方が、受け持った授業の成績や出欠、生徒から提出された資料などを保存しており保存された箇所をチェックするのが仕事です
そのチェックがすごく時間がかかるので、良い方法が有れば教えて欲しいです

生徒名フォルダ→◯◯年フォルダ→成績表エクセルや提出物のPDF
といったフォルダ状態になっており、1年以上通っている生徒は◯◯年フォルダが複数あります

毎日、一人づつフォルダを見て更新されているファイルや新しく保存されているファイルを印刷したり書きとめたりいます

私ができることは書き留めているエクセルファイルに
(生徒名フォルダ→◯◯年フォルダ)のハイパーリンクを設定する位で
結局の所、１ファイルずつ見て更新がかかっているファイルの中身を確認しています

生徒が100人近くいるため３時間くらい掛かり、又見落としも怖いです
こちらのサイトでファイル一覧取得の掲示板などを見せて貰いましたがよく分かりませんでした

どうにか、もう少し楽になる方法が有れば教えてもらえると嬉しいです

＜ 使用 Excel：unknown、使用 OS：unknown ＞

必要ファイルの条件が漠然としているので、もう少し教えてください。あと、実はMacです、とかだと使える命令が違ってきますので、バージョンとOSもunknownではなく、正確に教えてください。

チェックしたいファイル構成は、必ず \生徒名\年(4桁？)\*.pdfと、*.xls* ですね？ 生徒が何人いても、一人に必要なファイル名は決まっていると思いますが、それは何種類あって、同一ファイル名でしょうか？ それとも、ファイル名中に名前や番号が入る等、別々のファイル名でしょうか？

提案としては、以下のようなレイアウトの一覧シートを作成し、マクロでフォルダ内を調べて、ファイルの更新日を表示、更新があれば太字強調とかすれば、確認が楽になると思うのですが、いかがでしょうか。 

	A			B		C		D		E
1				生徒名1		生徒名2		生徒名3		生徒名4
2	2017\ファイル名1.pdf	2017/3/21	2017/3/21		
3	2017\ファイル名2.xlsx	2017/3/21			
4	2017\ファイル名3.xlsx			2017/3/21	
5	2017\ファイル名1.pdf	2018/6/1	2018/6/1	2018/6/1	2018/6/1
6	2017\ファイル名2.xlsx	2018/5/22	2018/5/22	2018/5/22	2018/5/22
7	2017\ファイル名3.xlsx	2018/6/1	2018/6/1			2018/6/1
8	2017\ファイル名4.xlsx	2018/5/4			2018/5/4	2018/5/4
（???） 2018/06/01(金) 09:30

 少しコードを組んでみました。
 昨日以降に更新されたpdfファイルの一覧を作成、ハイパーリンクをはるマクロです。
 フォルダパスは任意で変えてください。


 Option Explicit
 Sub TEST()
    Dim FileData
    Dim i As Long
    Dim n As Long
    Dim targetDate As Date


    targetDate = Date - 1   '昨日以降
    Range("A:C").Clear
    FileData = MakeFileList("C:\TEST", targetDate, "*.pdf")     '任意のフォルダや拡張子を指定
    If IsEmpty(FileData) Then
        Range("A" & n + 1).Value = "該当ファイルなし"
    Else
        For i = 0 To UBound(FileData)
            If Len(FileData(i)) Then
                Range("A" & n + 1).Resize(1, 3) = Split(FileData(i), ",")
                ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & n + 1), Address:=Range("A" & n + 1).Value
                n = n + 1
            End If
        Next i
    End If
 End Sub


 Function MakeFileList(SearchDir As String, ModifiedDate As Date, SearchFile As String)
    Dim TMPFile As String
    Dim CMDstr As String
    Dim Buf() As Byte
    Dim FileList() As String
    Dim FileNum As Long
    Dim TargetPath
    TMPFile = Environ("TEMP") & "\Dir.tmp"
    CMDstr = "ForFiles /P " & """" & SearchDir & """" & " /M " & SearchFile & " /S /D +" & ModifiedDate & " /C " & """" & "cmd /c echo @path, @fdate, @ftime" & """" & "> """ & TMPFile & """"
    With CreateObject("Wscript.Shell")
         .Run "cmd /c" & CMDstr, 0, True
    End With
    If Len(Dir(TMPFile)) > 0 Then
        If FileLen(TMPFile) < 1 Then
            Kill TMPFile
            Exit Function
        End If
    Else
        Exit Function
    End If
    FileNum = FreeFile
    Open TMPFile For Binary As #FileNum
        ReDim Buf(1 To LOF(FileNum))
        Get #FileNum, , Buf
    Close #FileNum
    Kill TMPFile
    FileList() = Split(Replace(StrConv(Buf, vbUnicode), """", ""), vbCrLf)
    MakeFileList = FileList
 End Function
（ろっくん） 2018/06/01(金) 11:33
？？？さん
お返事ありがとうございます！
何を聞きたいかわからない状態での質問にお返事頂けて嬉しいです。
パソコンはWindows7でしたエクセルは、いつも使っているのは2010でたまに2007でも作業しています。
ファイル構成は下記の状態です。
\d\生徒情報\学年(中1-3まで３つあります)\生徒名(生徒数分)\◯◯年(1-3個ある内の2018年だけ)
見ているのは2018年フォルダだけです。
チェックしたいファイルは、エクセルとワードとテキスト、PDF(紙資料をスキャンしたもの)、JPG(生徒からメールで送られてきたもの？)というファイルも有りバラバラです。
私学推薦の生徒は特にファイル数が多いです。
◯◯年フォルダの中に資料一式と言ったフォルダも作られています。

ファイル名は絶対共通であるのが、生徒名+成績表エクセルと生徒名+誓約書pdf位です。

新しく保存されるファイルの中には、更新日付けが古いものもあり今は目視でファイル名と更新日付を確認しています。

書きとめファイルの中に入っていないファイルが保存されていれ、更新日付けが古くてもチェックしファイル名と更新日付けをメモしています。

上手く伝えられなくてごめんなさい。
前任者の方からは「気が遠くなる作業だから頑張ってね」と言われるくらい果てしない作業です。
3時間がせめて2時間くらいで終われば、肩も凝らずに目も疲れずにすむのですが...
他に不足している情報が有りましたら、仰って下さい。
よろしくお願いします。
（ウララ） 2018/06/01(金) 12:36

ロックンさんもお返事ありがとうございます！
後で確認させていただきます。
取り急ぎお礼まで
（ウララ） 2018/06/01(金) 12:37
ファイル名に個人名が入っているので完全一致しないし、他にもいろいろなファイルもあるし、縦横の表にするのは得策ではないようですね。 ならば、1ファイル1行で出力し、フォルダ名上位だけ抜き出して一覧化した例なぞ書いてみます。 オートフィルタでも設定すれば、これでも十分実用できるでしょう。 マクロは標準モジュールに貼り付けた後、実行する前にブック保存してください。

なお、対象ファイルが更新されていた場合、日時部分を太字に、新しく追加の場合は全部太字になるようにしています。 初回は全部新規扱いされてしまいますが、2回実行すれば普通のフォントに戻ります。 

 Sub test()
    Const cPATH = "c:\d\生徒情報\"
    Dim DIC As Object
    Dim wkB As Worksheet
    Dim cFiles As Variant
    Dim vw As Variant
    Dim i As Long
    Dim j As Long
    Dim iw As Long
    Dim iR As Long
    Dim cw As String


    Application.DisplayAlerts = False


    Set DIC = CreateObject("Scripting.Dictionary")


    With Sheets(1)
        On Error Resume Next
        Sheets(.Name & "_bak").Delete
        On Error GoTo 0


        .Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = .Name & "_bak"
        Set wkB = Sheets(Sheets.Count)


        iR = .Cells(.Rows.Count, "A").End(xlUp).Row
        If 1 < iR Then
            .Rows("2:" & iR).Delete
        End If
        iR = 1


        cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/S/B """ & cPATH & "\*.*""").StdOut().ReadAll(), vbNewLine)
        For i = 0 To UBound(cFiles) - 1
            If LCase(cFiles(i)) <> LCase(ThisWorkbook.FullName) And InStr(cFiles(i), "$") = 0 Then
                iR = iR + 1
                vw = Split(Replace(cFiles(i), cPATH, ""), "\")
                iw = UBound(vw)
                .Cells(iR, "A").Value = cFiles(i)
                .Hyperlinks.Add Anchor:=.Cells(iR, "B"), Address:=cFiles(i), TextToDisplay:=vw(iw)
                .Cells(iR, "C").Value = FileDateTime(cFiles(i))
                For j = 0 To 2
                    .Cells(iR, j + 4).Value = vw(j)
                Next j
                .Cells(iR, "G").Value = Right(cFiles(i), Len(cFiles(i)) - Len(cPATH) - Len(vw(0)) - Len(vw(1)) - Len(vw(2)) - 3)
            End If
        Next i


        For i = 2 To wkB.Cells(wkB.Rows.Count, "A").End(xlUp).Row
            DIC.Add wkB.Cells(i, "A").Value, i
        Next i
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If DIC.Exists(.Cells(i, "A").Value) = False Then
                .Range(.Cells(i, "A"), .Cells(i, "G")).Font.Bold = True
            Else
                If .Cells(i, "C").Value <> wkB.Cells(DIC(.Cells(i, "A").Value), "C").Value Then
                    .Cells(i, "C").Font.Bold = True
                End If
            End If
        Next i
        .Select
        .Cells.Font.Size = 9
    End With


    Application.DisplayAlerts = True
 End Sub
（???） 2018/06/01(金) 13:47
書式はフォントサイズしか変えていないので、例えばC列は日付形式の「YYYY/MM/DD」だけにするとか、1行目にタイトル入力してオートフィルタをかけるとか、ご自由に変えてください。

また、マクロ実行すると毎回指定フォルダ以下の全ファイル情報を得るので、データが貯まってきて遅くなった場合、過去分の見なくても良いフォルダは、先頭に「$」を付けるとか、ファイル名のどこかに「$」が含まれている場合は無視するようになっているので、これを利用してみてください。
（???） 2018/06/01(金) 13:57

???さん
たくさんのコードありがとうございます。
お返事遅くなってすいません。
標準モジュールに張り付ければいいのでしょうか？
やってみたのですが、↓の場所が黄色くなって止まってしまいました。
リセットボタンを押したら黄色が消えるのですが、一覧表が表示されません。
どこかやり方が間違っていたらすいません。
教えていただけますか？
宜しくお願いします。 
    .Cells(iR, j + 4).Value = vw(j)
実行時エラー９インデックスが有効範囲にありません
（ウララ） 2018/06/02(土) 21:59

 ？？？さん
もう１つ質問させてください。
$がついたファイル名を無視しますと教えてくださったのですが、旧とついたフォルダを無視しようとしたら
このコードを書き変えたらいいのでしょうか？
 If LCase(cFiles(i)) <> LCase(ThisWorkbook.FullName) And InStr(cFiles(i), "$") = 0 Then

試したいのですが、途中で止まってしまううので試せないでいます。
お手数ですが教えてください。
（ウララ） 2018/06/04(月) 20:56

エラーになるのは、指定したフォルダ階層より浅いところにもファイルが置かれているのではないでしょうか？ そうならば、jのループの最大は2固定ではなく、Ubound(vw) と 2 を比べて、小さい方にすれば良いでしょう。

旧フォルダ除外については、$ も付加すれば良いだけですが、$ に変えたくないならば、条件に And InStr(cFiles(i), "旧") = 0 を追加してください。 $ の条件はそのまま残すこと。（ブックを開いた際のテンポラリファイルは先頭に「~$」が付くのですが、これを除外するためです）
（???） 2018/06/05(火) 10:47

＞どうにか、もう少し楽になる方法が有れば教えてもらえると嬉しいです
えっとですね。

自分が楽したいなら、他人に仕事を頼めばいいですよね？
とはいえ、部下が無い身分なら頼める人がいないと思いますが、
パソコンは支給または貸与されているわけですよね？
で、パソコン（＝エクセル君）に仕事を頼むわけです。

他人もエクセル君も同じことなんですけど、
して欲しいことをちゃんと伝えないと希望の結果を返してくれません。
だから、誰かに仕事を頼むときのように、
して欲しいことを相手に伝わるように説明することから始めてください。

つまり、
1）前提条件
　　　→指定のフォルダーのパス（あるいは処理中に選択することもあり？)等
2）欲しい結果
　　　→前回みたときに無かったファイルのリストアップ
　　　→前回みたときと更新日時に変更があったファイルのリストアップ

3）見せ方
　　　→過去1回分のログと今回のログの比較
　　　→今回リストアップしたファイルへのハイパーリンク設定

とりあえずこういうところでしょうか？

まぁ、見せ方は置いておいて、
とりあえず、「今」何が欲しいのですか？

（まっつわん） 2018/06/05(火) 11:51

？？？さん、お返事ありがとうございます。
$の件、承知しました。
テンプラリファイルを表示させなくするためだったのですね。
昨日、上司に参照しないフォルダに$を付けていいか確認したところ
「訳が分からなくなるしダメだけど前年度以前分のフォルダ名に旧やオールド
と言った分かる名前を付けるならいい」と言われました。
フォルダ階層の浅いところにファイルがあるのでは？とご指摘有りましたが
今日はお休みなので明日の仕事中にもう一度確認&トライしてみようと思います。
（ウララ） 2018/06/05(火) 12:26
まっつわんさんもアドバイスとご指導いただきありがとうございます。
パソコンは、この質問の作業をしている時だけ上司のパソコンを借りています。

前提条件や見せ方など、凄くわかりやすいです。
綺麗に代弁してもらってありがとうございます。

だらだらと文章で書いてしまっていてすいませんでした。
「今」欲しいのは、過去1回分のファイル一覧と現時点のファイル一覧を
見比べて異なるものだけをピックアップしたいです。
ハイパーリンクがあったら更に助かると思います。
（ウララ） 2018/06/05(火) 12:37

なるほど、、、
それらのデータのバックアップはどうされてます？

BunBackupというフリーソフトは導入可能でしょうか？
ファイルのバックアップをするソフトなのですが、
ミラーリングという作業をすると、バックアップ元で増えたファイルはバックアップ先にコピーし、
バックアップ元で無くなったファイルはバックアップ先から削除します。
そして、そのログをみることも可能です。

**********************************************************************************

【2018/06/05 13:22:34】 $$Backup$$.lbk 00:00:11 8860 0 8860 0
コピーファイル 1
G:\現場\退休寺\新規 Microsoft Excel ワークシート (2).xlsx
エラーファイル 0
削除ファイル 1
G:\現場\退休寺\新規 Microsoft Excel ワークシート.xlsx

**********************************************************************************

↑テキストでも見れますしソフトからログを見るとツリー状に表示され、
ダブルクリックで当該フォルダがエクスプローラで開かれます。
当然コピーファイルは新しいファイルと更新されたファイルです。

上司と相談されて、こういうソフトの導入を検討されてはいかがでしょうか？
（フリー版ではなく有料版でもいいとは思いますが。）
あ、でも、そうしたら仕事が無くなりますよ？？？
エクセルでこっそりマクロを作って、さくっと処理して、昼寝でもして時間つぶしますかぁ?ｗｗｗ

（まっつわん） 2018/06/05(火) 13:33

まっつわんさんお返事ありがとうございます
フリーソフト良いですね！
上司に相談してみます。
ただ、５台ある内のインターネット使えるパソコンが塾長のパソコン(誰もさわれない)
だけなので、ちょっと厳しいかもしれません。。。
ちなみにバックアップは一切されていなかったので、USBメモリを
一本買ってもらい、作業終了後にコピーしています。

仕事がなくなるのは考えてませんでした(汗
マクロで空いた時間にこっそりお勉強したい今日この頃です。
（ウララ） 2018/06/05(火) 13:43

浅い階層にファイルがあって、そのマクロ対応がうまくいっていない場合、以下を試してみてください。 階層が浅い場合は、D列以降を使わないように変更してあります。 

 Sub test()
    Const cPATH = "c:\d\生徒情報\"
    Dim DIC As Object
    Dim wkB As Worksheet
    Dim cFiles As Variant
    Dim vw As Variant
    Dim i As Long
    Dim j As Long
    Dim iw As Long
    Dim iR As Long
    Dim iLen As Long
    Dim cw As String


    Application.DisplayAlerts = False


    Set DIC = CreateObject("Scripting.Dictionary")


    With Sheets(1)
        On Error Resume Next
        Sheets(.Name & "_bak").Delete
        On Error GoTo 0


        .Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = .Name & "_bak"
        Set wkB = Sheets(Sheets.Count)


        iR = .Cells(.Rows.Count, "A").End(xlUp).Row
        If 1 < iR Then
            .Rows("2:" & iR).Delete
        End If
        iR = 1


        cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/S/B """ & cPATH & "\*.*""").StdOut().ReadAll(), vbNewLine)
        For i = 0 To UBound(cFiles) - 1
            If LCase(cFiles(i)) <> LCase(ThisWorkbook.FullName) And InStr(cFiles(i), "$") = 0 Then
                vw = Split(Replace(cFiles(i), cPATH, ""), "\")
                iw = UBound(vw)
                iR = iR + 1
                .Cells(iR, "A").Value = cFiles(i)
                .Hyperlinks.Add Anchor:=.Cells(iR, "B"), Address:=cFiles(i), TextToDisplay:=vw(iw)
                .Cells(iR, "C").Value = FileDateTime(cFiles(i))
                If 1 < iw Then
                    iLen = 0
                    For j = 0 To 2
                        .Cells(iR, j + 4).Value = vw(j)
                        iLen = iLen + Len(vw(j)) + 1
                    Next j
                    .Cells(iR, "G").Value = Right(cFiles(i), Len(cFiles(i)) - Len(cPATH) - iLen)
                End If
            End If
        Next i


        For i = 2 To wkB.Cells(wkB.Rows.Count, "A").End(xlUp).Row
            DIC.Add wkB.Cells(i, "A").Value, i
        Next i
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If DIC.Exists(.Cells(i, "A").Value) = False Then
                .Range(.Cells(i, "A"), .Cells(i, "G")).Font.Bold = True
            Else
                If .Cells(i, "C").Value <> wkB.Cells(DIC(.Cells(i, "A").Value), "C").Value Then
                    .Cells(i, "C").Font.Bold = True
                End If
            End If
        Next i
        .Select
        .Cells.Font.Size = 9
    End With


    Application.DisplayAlerts = True
 End Sub
（???） 2018/06/06(水) 14:23
？？？さん
本当にありがとうございます！
浅い階層にファイルが間違って保存されていました。
スマホの画面見ながらペチペチ入力していたので２日掛かってしまいましたが
3時間かかっていた作業が30分程で終わりました。

本当にありがとうございました。

明日から、作業するふりをしてひとまず買ってきたエクセル初歩を熟読したいと思います。

マッツワンさんもロックンさんもありがとうございました。
作って頂いたコードが理解できるように頑張ります！
（ウララ） 2018/06/07(木) 20:03

コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.