VBAでのファイル名と更新日(作成日)の抽出

VBAにてあるフォルダにあるすべてのPDFファイル名と更新日(作成日)の抽出をしたいです。
A1セルに抽出するフォルダパス名が入っています。

A3セルより下(A3,A4,A5～)にファイル名
B3セルより下(B3,B4,B5～)に更新日(作成日)

を表示させたいです。

ご教示願います。

質問者からの補足コメント

• 

  回答ありがとうございます。
  回答を参考に試してみましたが、検索場所が共有フォルダであった為、非常に処理が遅いです。（固まってしまう。）
  dir関数を使用すると早いとネット上でありましたが、どのような構文を組めばよろしいでしょうか・・・？

    補足日時：2017/07/27 18:49

No.3 ベストアンサー 回答者： shut0325 回答日時： 2017/07/29 01:31

こんばんは。

本日、共有フォルダ（一部無線LANでの中継アリ）でいくつかテストしたのですが直接セルに取得した値を入力していくとかなり遅くなるようですね。

そこで、自分のPCのCドライブ直下に作業用のテキストファイルをつくり、そこにフォルダ内のファイルと更新日時をフィルタリングせずにずらっと書き込み。
それをExcelで、不要ファイルは無視しつつセルに入力していく、、という手法にしてみました。

ここでいう不要ファイルはMacから共有フォルダに書き込んだ際に出来ることがある、”.”で始まる隠しファイルの事です。

ちなみに、820個のファイルがある共有フォルダで、ワークテキスト作成が約20秒、それをExcelのセルに入力するのが「ほんの一瞬」です。
ファイルのなら並びはおそらくファイル名の昇順となっているようですが、そういったソート方法の変更もExcelに読み込んだのちに処理したほうが良いと思います。
ソート範囲の指定は、コードにもありますが、Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))というようなレコード数によって可変となるようにすれば大丈夫だと思います。

作業用テキストファイルは、該当するファイルが無い場合は新規で作りますし、既存の場合は、前回分はクリアされたうえで書き込まれます。
ファイルの設定場所は自分のPC上で権限ある場所ならどこでも構いません。

また、タブ区切りのテキストしているので、作業用テキストファイルを開いて全選択してコピー、A3セルをクリックした状態でペーストしても（不要ファイル除去を除いては）同じ結果が得られます。

ギリギリ現実な速度かなと思いますが、一度試されてみてください。


----以下　ソース---


Sub Pdflistup()

FolderPath = Range("A1").Value: 'セルA1にフォルダーのパスがあるということなので。
WText = "C:\WorkText.txt": '作業用テキストファイル

'該当フォルダにあるファイルの名称と更新日時を作業用テキストファイルに書き込む

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set FileObj = FileSys.GetFolder(FolderPath).Files
Set WorkText = FileSys.CreateTextFile(WText, True)

For Each PdfObj In FileObj

With PdfObj

WorkText.WriteLine (.Name & Chr(9) & .DateLastModified): '名称（タブ）更新日時の形で書き込み

End With

Next

WorkText.Close

Set FileSys = Nothing

'作業用テキストファイル作成処理完了


'セルの値をクリア（A3~Bの最終行まで）

Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).Clear


'WorkText.txtを開き、一行ずつセルに入力（ファイル名はA3から、更新日時はB3から）

Open WText For Input As #1

n = 3: '入力開始行

Do Until EOF(1)

Line Input #1, Tline

Tvalue = Split(Tline, Chr(9)): 'テキストをタブで分割（一次配列格納）

If Not Left(Tvalue(0), 1) = "." Then

Cells(n, 1).Value = Tvalue(0): 'n行A列にファイル名を入力
Cells(n, 2).Value = Tvalue(1): 'n行B列に更新日を入力
n = n + 1
End If
Loop

Close #1


'セル書き込み作業完了

MsgBox ("処理が完了しました。")


End Sub

この回答へのお礼

ありがとうございます。来週共有フォルダを使用して試してみます。

お礼日時：2017/07/29 07:36

No.2 回答者： shut0325 回答日時： 2017/07/27 23:30

shut0325です。

補足見ました。
今自宅なので、共有フォルダにアクセスする場合でのレスポンステストが出来ないのですが、DIR関数では、作成日時や更新日時などのプロパティが取得できません。

Dir関数とFileSystemObjectの共用も含め、高速処理できるための幾つかアプローチを試してみたいので、数日お時間下さい。

ちなみに該当フォルダにはどの程度の書類数（PDF以外も含め）があるのでしょうか。

この回答へのお礼

shut0325様>
補足確認ありがとうごうございます。
ネットワーク上の共有フォルダ内に”pdf”のみが10000個くらい入っています。(日々増える形)
日々の作業であるため、できるだけ早い高速処理を希望します。
お忙しいとは思いますが、よろしくお願いします。

お礼日時：2017/07/28 06:19

No.1 回答者： shut0325 回答日時： 2017/07/22 23:21

ファイル関連の事はFileSytemObjectというVBA外のオブジェクトのインスタンスを作って作業します。

このFileSytemObjectはVBSやVBでも良く使います。


下記の例ではCドライブ直下にfilesという名前のフォルダがあり、その中に該当のpdfファイルが入っている想定です。
該当のフォルダがある場所に書き換えてください。（フルパス）

また、B列には作成日時を、C列には更新日時としていますので、適時書き換えてください。





Sub Pdflistup()

Dim FileSys As Object

Set FileSys = CreateObject("Scripting.FileSystemObject")

'Cドライブのfilesフォルダー内の全ファイルオブジェクトを取得
Set FileObj = FileSys.GetFolder("C:\files").Files


i = 3: '３行目からなので


For Each PdfObj In FileObj

'全該当ファイルのうち、ファイルタイプがPDF（Adobe Acrobat Document）の場合のみセルに値を代入。

If PdfObj.Type = "Adobe Acrobat Document" Then

Range("A" & i).Value = PdfObj.Name: '.Name=ファイル名

Range("B" & i).Value = PdfObj.DateCreated: '.DateCreated=ファイル作成日時

Range("C" & i).Value = PdfObj.DateLastModified: '.DateLastModified=ファイル更新日時

i = i + 1

End If

Next

Set FileSys = Nothing

End Sub