VBA Nikon.NEFの撮影日時の取得で!!

Question

運用環境:Windows10(64bit),Excel2016(64bit)
テストデータ:例えば｢D:\Test9｣フォルダに､Nikon一眼レフ(D300,D810)で撮影した｢.NEF｣や｢.JPG｣ファイルが投稿されているとします。
現象:PC起動後に次の｢FileListUP｣を実行したら｢Nikon.NEF｣ファイルの撮影日時が正しく表示されません!?。
Excelを終了しないで他のフォルダの｢FileListUP｣を試しても｢Nikon.NEF｣は撮影日時が正しく表示されません。
但し､Excelを再起動して｢FileListUP｣を試みれば撮影日時は正しく表示されます。
尚、PCシャットダウン→PC起動した場合、前述した現象が度々発生(再現)します。
要約:｢Nikon.NEF｣の撮影日時が正しく表示されない現象は、PC起動後の初回のエクセル起動で発生しています。
補足:Windows10(32bit),Excel2010(32bit)の環境では当該現象は起きていません。
回避方法をご教授いただければ幸いです。

Sub FileListUP()
    Const vPath As Variant = "D:\Test9\"
    Dim Fso As Object
    Dim F1 As Object
    Dim vName As Variant
    Dim WT As Date
    Dim sDir As String
    Dim R As Long
    Dim Sap As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Sap = CreateObject("Shell.Application")
    Cells.Clear '初期化
    MsgBox "ファイルの検索を開始します。", 64
    Range("C1").Value = "フォルダ"
    Range("D1").Value = "ファイル"
    Range("E1").Value = "作成日時"
    Range("F1").Value = "更新日時"
    Range("G1").Value = "アクセス日時"
    Range("H1").Value = "撮影日時"
    Columns("E:H").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
    Columns("E:H").HorizontalAlignment = xlLeft
    R = 2
    For Each vName In Sap.Namespace(vPath).Items
        WT = vName.ExtendedProperty("WhenTaken") '撮影日時の取得(WorldTime)
        sDir = Dir(vName.Path, 7)
        If sDir <> "." And sDir <> ".." Then
            If (GetAttr(vName.Path) And vbDirectory) <> vbDirectory Then
                Set F1 = Fso.GetFile(vName.Path)  'フルパス("D:\Test9\DSC001.NEF"etc)
                Cells(R, 3) = vPath               'フォルダ
                Cells(R, 4) = vName               'ファイル
               'Cells(R, 4) = F1.Name             'ファイル
                Cells(R, 5) = F1.DateCreated      '作成日時
                Cells(R, 6) = F1.DateLastModified '最終更新日時
                Cells(R, 7) = F1.DateLastAccessed 'アクセス日時
                If WT <> 0 Then
                    Cells(R, 8) = WT + TimeValue("9:00:00") '撮影日時(LocalTime)
                End If
                R = R + 1
            End If
        End If
    Next
    Set F1 = Nothing
    Set Sap = Nothing
    Set Fso = Nothing
    Columns("A:Z").ColumnWidth = 1
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    MsgBox "◎◎◎処理完了◎◎◎", 64
End Sub

Answer 1

Windows10-Excel2016の環境下で、初回のExcel起動時に、Nikon一眼レフ(D300,D810)で撮影した｢.NEF｣の撮影日時が正しく取得できない現象が今だに解決しません…!!
補足:Windows10にUpdateする前のWindiws8.1とかWindows7-Excel2010の環境下では当該不具合は起きていませんでした。
  WT = vName.ExtendedProperty("WhenTaken")
撮影日時の取得(WorldTime)一旦Excelを終了して当該Excelファイルを開き直すと撮影日時が正しく取得できる現象…これはExcelの脆弱性(バグ)と思うのですが、Microsoftは既知の現象として把握しているのでしょうか？、脆弱性対応はされるのでしょうか？

Answer 2

ここは Microsoft に質問する場所でも苦情を言う場所でもありません。
不定期にスレッドを上げるぐらいなら、有償サポートに問い合わせてください。

（脆弱性は、弱いという文字が入っているように、本来守るべきものを守れていないとか、そういった場合に使われることが多いので、単なる不具合？を脆弱性と呼ぶことには違和感があります）

Answer 3

個人としては費用がかさみ｢有償サポート問い合わせ｣は致しかねます。

そうであれば、Microsoft の回答（現状認識の確認を含む）は得られないということを理解しておいてください。

また、Microsoft はすべての不具合の修正を保証していません。
困っている人が少ない不具合は「修正しない」と判断することがあり得ます。
（困っている人が多かろうが、プレミアサポートを使おうが、セキュリティ脆弱性ではない不具合が修正されるまでに数ヶ月かかるのも割と聞く事例ですが…。）

即ち、初回から正しく撮影日時が取得できることが｢あるべき姿｣ではないでしょうか（本来守るべきものを守れていない）。

その論理で言えば、すべての不具合を脆弱性と呼べてしまいます。
ソフトウェアの世界で「脆弱性」で守るべき対象は「セキュリティ」に限定されていると言って過言ではありません。
たとえば、総務省が公開する言葉の説明でも言い切っています。

http://www.soumu.go.jp/main_sosiki/joho_tsusin/security/basic/risk/11.html

→Excel初回起動での撮影日時が正しく取得できない(差異+16h)。Excel再起動で正しい撮影日時が取得できます。

その再現条件を聞いている限り、個人的には同じアプローチを取り得る限り、回避策が存在しない可能性が高いのでは？と思います。
（Windows 起動時に Excel を空起動して、終了してから使い始めるというのも立派な「回避策」ですけれども…）

よって、試していません。どちらかと言えば、別の方法（Shell.Application を使わない、Excel ではなく別の開発環境で Excel 生成するなど）を探すでしょうね…。

あるいは、Office (32bit) に変えてみて問題が起きないかどうか試すとか。

Answer 4

とりあえず、最初の１回目だけ発生したような印象でしたが、次以降の再起動でも再現しなくなったので、申し訳ないですが、私としては関心がなくなっています。
(Win10 1709 (x64) + Office 2016 1708 (32bit))

Answer 5

質問:別の方法(Shell.Applicationを使わない)とは？…
今まで色々試みては見たのですが｢yyyy/mm/dd hh:mm:ss｣を取得するに至っていません。

そういったライブラリを探すとか、そういったサンプルを探すとか。

自力でやる手もなくはないですが、Tiff IFD とか Exif IFD を理解しないとだめですね。
たとえば、NikonD300.NEF であれば…

1. 先頭 2 バイトの MM でビッグエンディアンだと判定できる
2. 0x0004-0x0007 で 0th IFD のオフセットがわかる
3. そのオフセット位置を TIFF ヘッダーを基準とした位置とみなして、シークしてから読み込む
4. 2 バイト読み込み、0x001B なので 0th IFD のタグ数は 27 個
5. ID 2 バイト、型 2 バイト、要素数 4 バイト、データ or オフセット 4 バイトを１組のタグとして順次読み込む
6. Exif IFD Pointer 0x8769 を見つけて、オフセットを知る（このファイルの場合 0x0258）
7. そのオフセット位置を TIFF ヘッダーを基準とした位置とみなして、シークしてから読み込む
8. 2 バイト読み込み、0x0020 なので 32 個タグがある。
9. ここでも ID ～ データ or オフセットの 2+2+4+4=12 バイト単位で読み込んでいく
10. 撮影日時を表す 0x9003 を見つけ、そのオフセットと要素数を知る（このファイルの場合 0x03F0 と 0x00000014）
11. そのオフセット位置を TIFF ヘッダーを基準とした位置とみなして、シークしてから読み込む
12. 0x00000014 なので 20 バイト読み込む
13. "2017:04:05 07:39:17" という文字列が得られるので日付・時刻と解釈する

私は基本 C#、手を出して C++ までなので、VB でロジックを書くことは手間がかかりすぎることもあり、コードの提供はできません。
なお、現象を安定的に再現させることは重要じゃないので、試していません。

Answer 6

まずExcel / VBAは CreateObject("Shell.Application") によりShell（≒エクスプローラ）を呼び出し、中継しているだけですので無関係です。

次にShellは Nas.ExtendedProperty("WhenTaken") により???から拡張プロパティWhenTakenを取得、中継しているだけですので無関係です。
少し脱線しますが、PSGetPropertyDescriptionByNameで説明がありますがWhenTakenは互換名でありWindows Vista以降の正式名称はSystem.Photo.DateTakenです。脆弱性やバグを指摘するのであれば、まず互換名を使用していることを認識し、また正式名称を知っている必要があります。

さて本題ですが ??? はどこからでしょうか。これはファイルの関連付けと同時に登録されるProperty Handlerとなります。具体的にはRegistering and Distributing Property Handlersの手順をたどることで特定できます。

レジストリの HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\PropertySystem\PropertyHandlers\.nef の デフォルト値、手元のPCでは {3DBEE9A1-C471-4B95-BBCA-F39310064458} となっていました。そこから HKEY_CLASSES_ROOT\CLSID\{3DBEE9A1-C471-4B95-BBCA-F39310064458}\InprocServer32 のデフォルト値、手元のPCでは C:\Windows\System32\WindowsCodecsRaw.dll でした。
残念ながら質問文には.NEFにどのプログラムが関連付けられているか、より正確には上記レジストリ状況がどのようになっているか記載がありません。

ともあれここで登録されているDLLが初回のみ何らか失敗するということなのでしょう。もし私と同じくWindowsCodecsRaw.dllが登録されていたのであれば、Windowsの問題の可能性が高いです。

もちろんWindowsCodecsRaw.dllの修正を求めることもできますが、NEF Codecやその他のライブラリを用いて別のDLLに差し替えることもできます。

Answer 7

理解した範囲で確認と試行をしてみました…問題は解決しませんでした。

佐祐理さんが示唆していた、解決するとしたらという話は、WindowsCodecsRaw.dll の代わりに同じ仕事をする DLL を入手・インストールしてみたらという話ですので、それにチャレンジしていないのなら、現状から変わりません。

Answer 8

私が投稿する前、１年近くにわたるご自身の行動を振り返るべきです。加えて実質的にスレッドを削除するような行為も。

私に限らず全ての回答者は見ず知らずのsakuraxxさんの質問に無償で答える義理は全くありません。ではなぜ無償の回答者がいるのか、それは質問者さん個人ではなく同様の問題を抱えるであろう他の開発者（検索で訪れるであろう将来の閲覧者）のため、Q&Aを蓄積するというフォーラムの趣旨に賛同したからでしかありません。
もし、sakuraxxさんの個人的な問題の解決だけを求めるのであれば、ここに限らず公開フォーラムの場で尋ねるのではなく、回答してくれる教師役を雇うことをお勧めします。

Answer 9

sakuraxx さん、こんにちは。フォーラム オペレーターの立花です。
MSDN フォーラムをご利用くださいましてありがとうございます。

Azulean さん、佐祐理さん、いつも貴重な情報をご提供くださり
ありがとうございます。

言い足りなこともあるかと存じますが、円滑なフォーラム運営のため、
皆様のご協力を何卒よろしくお願いいたします。

---

～ 参考になった投稿には回答としてマークの設定にご協力ください ～
MSDN/TechNet Community Support 立花楓

Answer 10

こんなん↓見つけたんですけど、頓珍漢な返信だったらごめんなさい。
------------------------------------------------
NEF Codec
http://downloadcenter.nikonimglib.com/ja/download/sw/22.html

3. Windows Vista、Windows 7及びWindows 8.1の64bitOSの対応について
Windows Vista、Windows 7及びWindows 8.1の64bit版において、エクスプローラー、
Windows フォトギャラリーまたはWindows フォトビューアーで
NEFファイルのサムネイルが正しく表示されないことがあります。
その場合は下記の手順でディスククリーンアップを実行してください。

1) [コンピュータ] のシステムドライブを右クリックし、[プロパティ]を選ぶ。
2) [全般]タブの[ディスク クリーンアップ]を選ぶ。
3) [ディスク クリーンアップ]タブの[削除するファイル]にある[縮小表示]にチェックを入れ、他の項目のチェックを外す。
4) [OK]を選んで、ディスククリーンアップを実行する。[これらのファイルを完全に削除しますか?] と表示されたら [ファイルの削除] を選ぶ。
※詳しい手順は こちら をご覧ください。
------------------------------------------------

Answer 11

○○さん情報ありがとうございます。
私の運用環境はWindows10にてご紹介のコーディックは該当しないと思います。
Azuleanさんの指摘をヒントに調べ事をして理解したのですが、
佐祐理さんが言われている「NEF Codec」が適当に思えます。暫定的には解決するものと思います。
恒久的には「C:\Windows\System32\WindowsCodecsRaw.dll」が一日も早く改訂される事を望みます。
掲題の件の主原因はExcelではなくWindows10の「WindowsCodecsRaw.dll」が現状においては各社のカメラコーディックに対応していない(レガシー)と言う事になるのでしょうね。

---

sakuraxx

Answer 12

Codec の置き換えを提案しているわけではありません。
先の返信で示した「ディスククリーンアップ」をしてみたら。。。。ということです。
NEF ファイルは Nikon デジカメ独自の Raw フォーマットだから、WindowsCodecsRaw.dll に実装されている NEF Codec は Nikon から情報提供を受けているはずです。
もしかしたら WindowsCodecsRaw.dll 内の NEF Codec 部分は、Nikon からソース コード提供してもらっている可能性もあるのでは？
だとしたら NEF Codec Ver.1.25.0 と同じ問題が、WindowsCodecsRaw.dll にも内在する可能性もあると思ったので、「ディスククリーンアップ」部分の説明だけをコピペしたのです。
まぁ Nikon の最新 NEF Codec を使うのであればやる意味はないのかもしれませんが、仮に「ディスククリーンアップ」で WindowsCodecsRaw.dll の問題が改善するのであれば、この問題は NEF Codec Ver.1.25.0 と同じ原因かも。。。。という切り分けができると思ったので。

Answer 13

○○さんご教授ありがとうございます。
掲題の件は約１年前から解決していなかった案件でした。
その間ディスククリーンアップは不定期ではありますが３ヶ月に一度くらい実施しています(システムイメージバックアップ前に)。
依ってこれが原因とイメージできなかったのでついコーディックが問題解決の手段かも知れないと直感しました。
折角の機会なので、今日「NEF Codec」を下調べした上でインストールして見ました。
http://downloadcenter.nikonimglib.com/ja/download/sw/97.html
Windows 10 Home / Windows 10 Pro / Windows 10 Enterprise 32bit/64bit版 - Ver.1.31.0
≪試行結果≫
掲題のマクロ｢Sub FileListUP｣を実行した結果、撮影日時が正しく取得できました…問題解決。
試行に使用したファイルは、RAW→JPG変換した次の３セットです。NikonもCannonもOKでした…!?
NikonD300.jpg
NikonD300.NEF
NikonD810.jpg
NikonD810.NEF
CanonEos5DSR.JPG
CanonEos5DSR.CR2

追記:お名前書きづらかったので○○さんと表現しました…ご容赦くださいませ。

---

sakuraxx

Answer 14

最新の Nikon NEF Codec 適用で問題が解決したということは、佐祐理さんが回答されている内容が、この問題の原因と解決方法に関する正に本質を示している、ということだと思います。

以下余談ですけど。。。。
Codec に限らず、デバイス ドライバやデバイスをサポートするユーティリティなど様々なソフトウェアで、マイクロソフトとデバイス メーカーの２系統から、同一目的の異なるソフトウェア モジュールが提供されていることが多々あります。
そーいった場合どっちを使ったら (インストールしたら) いいのか迷うことがありますが、マイクロソフト社製は汎用目的でメーカー製は機能重視。。。。というのが一般的な認識では？
そのデバイス (あるいは製品) の特性を 100% 引き出したいならメーカー製が推奨され、フツーに使えればそれで十分ならマイクロソフト社製のもの。。。。というすみ分けだと思っています。
今回のケースも、それと同様のことでは？
なんで Nikon 製 NEF Codec の利用を躊躇していたのか、私にはその理由がわかりませんけど、完璧なソフトウェアなんて存在しえないと思っているので、目的に合わせて適宜使い分けることも重要ではないかと。
もっともメーカー製が必ず機能的に優れている保証はありませんし、大昔に Sony が CD に Rootkit を仕込んで問題になったように、裏で何やってるのかわかりませんけど。
(まぁそんなことを言ったら、マイクロソフトがこっそりバックドアを仕込んでいる可能性も否定できませんし。ｗｗｗｗ)

Answer 15

○○さん貴重なコメントありがとうございます。
おっしゃる通りです私も汎用的な運用が肝要と思います。
Nikon NEF Codec はアンインストールして、Win10デフォルトで運用する事にします。

Answer 16

私は別に、「汎用的な運用が肝要」と言ってる訳ではないのですが。。。。
要は、目的に合わせて適宜使い分ける柔軟性が重要なのでは。。。ということです。
"Nikon NEF Codec" をインストールすることで、汎用性が失われるとは思っていませんし。
使いたきゃインストールすればいいし、使ってみて「いらねー」と思ったらアンインストールすればいいし、ただそれだけ。
ただし、世の中には裏で何やっているのかわからない、挙動不審なソフトウェアが多数存在するので、そーいう変なものはインストールしないように、注意する必要はあると思います。
なので私は PC に何かソフトウェアをインストールする際には、まず仮想マシン上にインストールしてみて、DLL Injection、Code Injection、API Hook 等の有無を確認してから、自分の PC にインストールするかどうかを判断してます。
(もっともそれだけで十分かというと、全然そんなわけありませんけど、変なものをインストールしてしまうリスクは、若干低減できてる。。。。と思っています。)

なお本スレッドでの質問内容に関してもっとも適切な「回答」は、佐祐理さんからの返信だと私は考えます。
少なくとも私からの返信は、「回答」には全く該当しません。
自分で書いといてなんですけど、はっきり言いて「ごみ」のレベルです。
なので私の返信にマークした「回答」は、早急に外してください。
(自分の「ごみ返信」が「回答」としてマークされるなんて、恥をさらしているようで嫌です。。。。できることなら削除したい気分ですけど、それも無責任なようで嫌なので。)
将来このスレッドを参照される方のためにも、佐祐理さんからの返信を「回答」としてマークされることを強くお勧めします。

Answer 17

良く分かりました訂正しました。

---

sakuraxx

Answer 18

もぅ１つの方のマークも、外してもらえると嬉しいです。

Answer 19

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

そもそも、エクスプローラの詳細表示のための機能です。エクスプローラの詳細表示では正常なのですか？そこで正常なら修正は期待できないでしょう。異常ならフィードバックハブからフィードバックする。

エクスプローラの詳細表示で正常なら、その方法を真似ればよい。extendedproperty()でなく、getdetailsof()ではどうなのか。とか。shell32.dllでなく、explorer.exeを使う方法もある。

そういえば、時間の掛かるプロパティは取れないという制約があったような。フォルダの総ファイルサイズなど。初回はタイムアウトしてるのかも。エクスプローラで表示してからexcelを実行したらどうなるか。

Answer 20

今は"Nikon NEF Codec" をアンインストールしてWindows10デフォルトの状態です。
エクスプローラの詳細表示は正常です。
試行:getdetailsof()によるプロパティ情報を次のマクロで取得して見ました。

Sub Sample_GetDetailsOf()
    Dim oShell  As Object
    Dim oFolder As Object
    Dim sText   As String
    Dim N       As Long
    Dim vFolderName As Variant
    Dim vFileName   As Variant
    vFolderName = "D:\Test1"
    vFileName = "NikonD300.NEF"
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace(vFolderName)
    For N = 0 To 34
        sText = sText & N & " " & _
            oFolder.GetDetailsOf(, N) & "=" & _
            oFolder.GetDetailsOf(oFolder.ParseName(vFileName), N) & vbCrLf
    Next
    MsgBox sText
End Sub

撮影日時がyyyy/mm/dd hh:mmまでしか取得できませんでした。秒の値までが必要なので getdetailsof()は適当でありません。

<<shell32.dllでなく、explorer.exeを使う方法もある。>>
非力にてexplorer.exeを使う方法は分からなかったので評価できませんでした。

Answer 21

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

getdetailsofで取れるなら、その後でextendedpropertyで取り直すと取れるかも。

ファイル名をエクスプローラと同じ順序にソートする。: Windows Script Programming
shell.spplicationと微妙に動作が異なるので試してみないと分からない。
VBAにするには少し翻訳が必要。

Answer 22

暫定的にこんなやり方でも、
（初回 表示されるまで時間が掛かってなんかおかしいけど）

1. まず、NikonD300.NEFをコピーして C:\var\raw\0.NEF としておきます。
（この0.NEFの撮影日時は[2017-04-05 07:39:17]なので この時刻と
ExtendedProperty("WhenTaken")
で得られた時刻との差を見て時差を補正するというやり方です。）

2. フォルダ位置を変えています。（DVDドライブなので）
wPath = "D:\Test9\" を wPath = "C:\var\test9" に

Sub FileListUP2()
   Dim Fso As Object
   Dim F1    As Object
   Dim Nas   As Variant
   Dim Nt    As Date
   Dim wPath As Variant
   Dim wDir  As String
   Dim R     As Long
  
   Dim flg0  As Boolean
   Dim wExt  As String
   Dim tDiff As Date: tDiff = "0:00:00"
   Dim objShell As Object
 
   Set Fso = CreateObject("Scripting.FileSystemObject")
   Set objShell = CreateObject("Shell.Application")
   Application.ScreenUpdating = False
  
   If Fso.FileExists("c:\var\raw\0.NEF") Then
      Set wPath = objShell.Namespace("c:\var\raw")
      For Each Nas In wPath.Items
         If Nas = "0.NEF" Then
            tDiff = Nas.ExtendedProperty("WhenTaken") - #4/5/2017 7:39:17 AM#
            Debug.Print DateValue(tDiff) & ", " & TimeValue(tDiff)
            flg0 = True
            Exit For
         End If
      Next
      Set wPath = Nothing
   Else
      MsgBox "c:\var\raw\0.NEF が存在しません"
   End If
   'Stop
  
   Cells.Clear '初期化
   MsgBox "ファイルの検索を開始します"
   Range("C1").Value = "フォルダ"
   Range("D1").Value = "ファイル"
   Range("E1").Value = "作成日時"
   Range("F1").Value = "更新日時"
   Range("G1").Value = "アクセス日時"
   Range("H1").Value = "撮影日時"
   Cells.Font.Name = "ＭＳ ゴシック"
   Columns("E:H").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
   Columns("E:H").HorizontalAlignment = xlLeft
   R = 2
   wPath = "C:\var\Test9\"
   For Each Nas In objShell.Namespace(wPath).Items
      Nt = Nas.ExtendedProperty("WhenTaken") '撮影日時の取得(WorldTime)
      wDir = Dir(Nas.Path, 7)
      If wDir <> "." And wDir <> ".." Then
         If (GetAttr(Nas.Path) And vbDirectory) <> vbDirectory Then
            Set F1 = Fso.GetFile(Nas.Path)    'フルパス
            Cells(R, 3) = wPath               'フォルダ
            Cells(R, 4) = F1.Name             'ファイル
            Cells(R, 5) = F1.DateCreated      '作成日時
            Cells(R, 6) = F1.DateLastModified '最終更新日時
            Cells(R, 7) = F1.DateLastAccessed 'アクセス日時
            If Nt <> 0 Then
               wExt = Fso.GetExtensionName(Nas)
               If flg0 And (wExt = "CR2" Or wExt = "NEF") Then
                  Cells(R, 8) = Nt - tDiff
               Else
                  Cells(R, 8) = Nt + TimeValue("9:00:00") 'LocalTime
               End If
            End If
            R = R + 1
         End If
      End If
   Next
  
   Columns("A:Z").ColumnWidth = 1
   Cells.EntireColumn.AutoFit
   Application.ScreenUpdating = True
   Set F1 = Nothing
   Set objShell = Nothing
   Set Fso = Nothing
   MsgBox "◎◎◎処理完了◎◎◎", 64
End Sub

（動作はしますけど... ）

Answer 23

ery srowさんノウハウの提示ありがとう御座います。
何とか内容が理解できました。
試行:正常に動作しました…確かに初回は表示されるまで時間が掛かりましたが止むを得ない事かも知れません。
実線向きのExcelツールとして運用する際に各パソコンにマスターファイル｢c:\var\raw\0.NEF｣を用意しなければならないのが辛い…改善できないかなどを更に検討したいと思います。

---

sakuraxx

Answer 24

ウィンドウズスクリプトプログラマさんが書かれたことで、sakuraxxさんが「撮影日時がyyyy/mm/dd hh:mmまでしか取得できませんでした。」と書かれていますが、やってみると「12 撮影日時=?2017-?04-?05 ??7:39」となって、時差の補正が必要ないようで使いやすいと思いました。

つまり秒のところだけ、ExtendedPropertyの値を使えばいいのではないかと

sakuraxxさん やってくださいませんか？（私もやってみますけど、組合わせる方法が分からない）
（いま時間がなくて混乱した文章になっているかもしれません）

[追加]2018-03-14 Wed．09:32
あ ダメでした。"12 撮影日時=?2017-?04-?05 ??23:39"となっていました。
マスター日付として使えません。すみませんでした。

Answer 25

あくまでも MS 製 Codec での解決を追求するのであれば、根本原因をもう少し調べてみては？
あくまでも推測ですけど。。。。
「PC起動後の初回のエクセル起動で発生」ということは、そのタイミングだけ Codec 関連 DLL のロードに失敗している可能性も考えられるのでは？
だとしたら、その DLL を明示的にロードさせるコードを追加してやれば、この問題を解決できるかも。。。。と思うのです。
つまり、Excel プロセス内にロードされている DLL に差異がないか確認してみては。。。。ということです。

プロセス内にロードされている DLL モジュールは、"Process Explorer" あるいは "Process Monitor" か、どっちかを使えば確認できます。
(個人的には "Process Monitor" の方が好きですけど、どちらも Mark Russinovich 大先生作のツールで、本当に「かゆい所」にまで手の届いたすんごいアプリです。)
-------------------------------------------
Process Explorer v16.21
https://docs.microsoft.com/en-us/sysinternals/downloads/process-explorer

Process Monitor
https://technet.microsoft.com/ja-jp/sysinternals/processmonitor.aspx
-------------------------------------------

調べるプロセスにもよりますが、手元の Windows 10 x64 環境にインストールされている Excel 2016 で、Excel プロセスにロードされている DLL モジュールの数を調べたら、およそ 150 個程度のファイルがロードされていました。
以前にも他の方からの質問で同じような提案をしたことがあるのですが、その方は「そんなにたくさんのファイルをいちいち調べらるか！！」とお怒りモードで投げ出しちゃったみたいですけど。
まぁ、150 個程度のファイルのロードの有無を調べるだけなら、根性出せば１時間もあれば確認できると思いますので、個人的には調べる価値はあると思いますが、無理強いしている訳ではありませんのであしからず。

Answer 26

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

各パソコンにマスターファイル｢c:\var\raw\0.NEF｣を用意しなければならない

バイナリ配列で定義して書き出す。

Answer 27

PC環境:Windows10(64bit),Excel2016(32bit)に、Process Monitorをダウンロードしてチャレンジして見ました。
フィルターは、Process Monitor Filterダイアログで、
[Process Name] is [EXCEL.EXE] then [Include] と設定し、[Add] をクリック。
そして当該Excelファイルを起動しました。
プロセスは｢EXCEL.EXE｣に絞り込めたものの数えきれない件数が表示されました…!?。
非力な私には差分を比較しきれませんでした…ギブアップ。

---

sakuraxx

Answer 28

アドバイスありがとう御座います。非力にて「バイナリ配列で定義して書き出す」コードが分かりません。

---

sakuraxx

Answer 29

下記サイトを参考に、Excel 起動から問題現象が発生するまでのイベントをキャプチャを採取し、それを PML ファイルに保存されることをお勧めします。
初回起動時と２回目以降の起動時の２パターンをとりあえず採取しておけば、あとの調査はその２つの PML ファイルだけでできます。
-------------------------------------------
Process Monitor を使用してシステムイベントをキャプチャする
https://community.sophos.com/kb/ja-jp/119038
-------------------------------------------

もっとも無理強いしている訳ではないので、ギブアップするならそれで構いませんが、「マクロソフトのバグだ！！」と主張するなら、それを裏付ける根拠が必要かと。
現在までの経緯を見る限り、この問題がマクロソフトのバグで発生していると言い切るだけの根拠はない。。。と私は考えています。

Answer 30

初回起動時と２回目以降の起動時の２パターンを｢.PML｣と｢.CSV｣の両方を採取しました。
下記は｢Logfile_Events.CSV｣の初回と次回の値をエクセル関数で比較した結果です（各々約21万行）。
最初の2,3,7,8,9,10行目に違いが視られ205行を過ぎると×が連発していて意味合いを解析する事は気が遠くなります。
初回と次回には差がある様に見えますが理解できないLogデータの連続でもあり…ギブアップです。
連番  Operation Path Result Detail
201 ○ ○ ○ ○
202 ○ ○ ○ ○
203 ○ ○ ○ ○
204 ○ ○ ○ ○
205 × × ○ ×
206 × × ○ ×
207 × × × ×
208 × × ○ □
209 × × × ×
210 × × ○ □
211 × × × ×

初回と同じ→○
初回と違う→×
片方が空白→□

---

sakuraxx

Answer 31

Process Monitor のウィンドゥに表示されているリストを、いちいち調べるわけではありません。
そんなことしてたら、今年が終わっちゃいます。
調べ方としては。。。。さらにフィルタ項目を追加して表示されるリストをさらに絞り込んで、その中の特定の１つを選んで、それだけを調べる。。。。ということです。
それを、初回起動時と２回目以降の起動時の２パターンに対して行い、その差異を調べる。。。。ということです。
それだけだったら、１時間もあれば終わります。
もっと詳しい説明が必要でしょうか？
(ギブアップするなら、それで構いませんけど。)

Answer 32

それはそうなんでしょうが、フィルタ項目として何を追加したら良いかとか、絞り込み方が分かりません…教えて下さい。

---

sakuraxx

Answer 33

{00 32 30 31 37 3A 30 38 3A 30 33 20 32 31 3A 32 39 3A 30 35 00}
.2017:08:03 21:29:05.
という日付文字列を見つけるという簡単なやり方です。
ARW, CR2, NEF, RAF の場合は1000バイト以内に出てくるようですが、ORF, RW2 は8KB以上必要かも（ファイルサイズにより異なるかもしれません）。
写真フォルダを "C:\var\Test9"に変更しています。

Sub FileListUP6()
   Dim Fso As Object
   'Dim Fso As New FileSystemObject 'if 事前バインディング
   Dim Nas   As Variant
   Dim Nt    As Date
   Dim wPath As Variant
   Dim wDir  As Variant
   Dim R     As Long
  
   Dim objShell As Object
   Dim objFile As Object
   Dim wExt  As String
  
   Dim inputfName As String
   Dim inputFn As Long
   Dim buff() As Byte
   Dim i As Long, j As Integer
   Dim dt As String
  
   Cells.Clear '初期化
   MsgBox "ファイルの検索を開始します"
   Range("C1").Value = "フォルダ"
   Range("D1").Value = "ファイル"
   Range("E1").Value = "作成日時"
   Range("F1").Value = "更新日時"
   Range("G1").Value = "アクセス日時"
   Range("H1").Value = "撮影日時"
   Cells.Font.Name = "ＭＳ ゴシック"
   Columns("E:H").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
   Columns("E:H").HorizontalAlignment = xlLeft

   R = 2
   wDir = "C:\var\Test9"
   Set objShell = CreateObject("Shell.Application")
   Set wPath = objShell.Namespace(wDir)
   Set Fso = CreateObject("Scripting.FileSystemObject")

   For Each Nas In Fso.GetFolder(wDir).Files
      Cells(R, 3) = wDir               'フォルダ
      Cells(R, 4) = Nas.Name             'ファイル
      Cells(R, 5) = Nas.DateCreated      '作成日時
      Cells(R, 6) = Nas.DateLastModified '最終更新日時
      Cells(R, 7) = Nas.DateLastAccessed 'アクセス日時
 
      Set objFile = wPath.Items.Item(Nas.Name)
      wExt = UCase(Fso.GetExtensionName(Nas))
      If wExt = "ARW" Or wExt = "CR2" Or wExt = "NEF" Or wExt = "RAF" Then
         inputfName = Nas.Path
         inputFn = FreeFile
         Open inputfName For Binary As #inputFn
            ReDim buff(1200)
            Get #inputFn, , buff
         Close #inputFn
         For i = 6 To UBound(buff) - 16
            If buff(i - 5) = 0 And buff(i) = 58 And buff(i + 3) = 58 And buff(i + 6) = 32 And buff(i + 9) = 58 And buff(i + 12) = 58 And buff(i + 15) = 0 Then
               dt = ""
               For j = 1 To 20
                  If j = 5 Or j = 8 Then
                     dt = dt & "/"
                  Else: dt = dt & Chr(buff(i - 5 + j))
                  End If
               Next j
               Debug.Print R & ": " & i & "B, " & dt
               Exit For
            End If
         Next i
         Cells(R, 8) = dt
      ElseIf wExt = "ORF" Or wExt = "RW2" Then '省略. buff(10000)位必要
         Nt = objFile.ExtendedProperty("WhenTaken")
         If Nt <> 0 Then
            Cells(R, 8) = Nt + TimeValue("9:00:00")
            Range("H" & R).Font.Color = RGB(255, 0, 0)
         End If
      Else
         Nt = objFile.ExtendedProperty("WhenTaken") '撮影日時
         If Nt <> 0 Then
            Cells(R, 8) = Nt + TimeValue("9:00:00")
         End If
      End If
      Set objFile = Nothing
      R = R + 1
   Next Nas

   Columns("A:Z").ColumnWidth = 1
   Cells.EntireColumn.AutoFit
   Application.ScreenUpdating = True
   Set Fso = Nothing
   Set wPath = Nothing
   Set objShell = Nothing
   MsgBox "◎◎◎処理完了◎◎◎", 64
End Sub

事前バインディングにしたほうがよいと書いてあるものがあったので やってみましたが遅いままでした。（VBEの画面で、「ツール」-「参照設定」で ”Microsoft Scripting Runtime" にチェック。）

Answer 34

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

ファイル名をエクスプローラと同じ順序にソートする。: Windows Script Programming

まずはvbsでexplorer objectで取れるかどうか確かめたらどうか。

Answer 35

私からの説明が至らなかったようで、申し訳ありませんでした。
Process Monitor でのフィルタ条件は、解析する対象に依存して異なるので、「必ずこれが正しい手順」というものはありません。
なので以下に示す手順は、「あくまでも私だったら、こーやって調べる」という一例にすぎませんので、その点はあらかじめご了承ください。

---------------------------------------------------
<本件における Process Monitor での解析手順>

以下に示す手順は、あらかじめ初回起動時と２回目以降の起動時の２パターンの PML ファイルが採取されていることを前提としています。

[手順１]
２回目以降の起動時に採取した PML ファイルを Process Monitor 上から開き、下記フィルタを追加 ("Add" ボタンの押下) し適用 ("Apply" ボタンの押下) します。
【フィルタ条件】
 "Process Name" "is" "EXCEL.EXE" then "Include"
 "Operation" "is" "ReadFile" then "Include"

[手順２]
Process Monitor ウィンドウに表示されている "ReadFile" イベントのうち、一番最後にリストされてもの (タイムスタンプが一番最後のもの) をダブルクリックし、その "ReadFile" イベントの "Event Properties" ダイアログを開きます。

[手順３]
"Event Properties" ダイアログ" の "Process" タブをクリックします。

[手順４]
"Process" タブ下段の "Modules:" リストボックスの "Module" カラムをクリックし、モジュール名でソートします。

[手順５]
ソートした "Modules:" リストボックスに "WindowsCodecsRaw.dll" が存在していることを確認します。
ここで "WindowsCodecsRaw.dll" が見つからない場合は、上記 [手順２] に戻り、一つ前にリストされている "ReadFile" イベントに対して [手順５] までを繰り返し、"WindowsCodecsRaw.dll" がリストされてる "ReadFile" イベントを探します。

[手順６]
"Process" タブ下段の "Modules:" リストボックスに、"WindowsCodecsRaw.dll" が存在する "ReadFile" イベントが見つかったら、"Process" タブ プロパティ シートの一番下にある "Copy All" ボタンをクリックします。

[手順７]
別途 Excel.exe を起動させ、"空白のブック" テンプレートで新規シートを作成し、上記 [手順６] でクリップボードにコピーしたテキスト情報を "貼り付け" ます。

[手順８]
上記 [手順１] に戻り、初回起動時に採取した PML ファイルに対して、[手順１] から [手順７] を実施ます。

[手順９]
上記までの手順で採取された、初回起動時と２回目以降の起動時の新規シート情報に対して、"Modules:" 以降にリストされている全モジュール名を比較します。
このとき、特に下記事項に着目して比較します。

【モジュール比較時の着目点】
☆ ２回目以降の起動時にのみ存在するモジュール名はあるか。
☆ 初回起動時と２回目以降の起動時双方で、"Microsoft Corporation" 以外の会社名のモジュール (3rd ベンダー製モジュール) の確認。
---------------------------------------------------

Answer 36

Process Monitor での解析結果

☆２回目以降の起動時にのみ存在したモジュール名。
kernel32.dll
C:\Windows\System32\kernel32.dll

☆"Microsoft Corporation"以外の会社名のモジュール名。
初回起動時は、
Advanced Micro Devices, Inc.
C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\aticfx32.dll
C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\atidxx32.dll
C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\atiuxpag.dll
Trend Micro Inc.
C:\Windows\SysWOW64\tmumh\20019\TmMon\2.6.0.2023\tmmon.dll
C:\Windows\SysWOW64\tmumh\20019\AddOn\7.30.0.1081\TmUmEvt.dll

２回目以降の起動時は、…初回起動時と同じ

以上

---

sakuraxx

Answer 37

｢ファイル名をエクスプローラと同じ順序にソートする｣の件、試みては見たのですが、
Sub Sample002()
For Each FolderItem In Folder.Items()
  WScript.Echo FolderItem.Name  '←実行エラー424: オブジェクトが必要です。
Next

VBAコードの場合はどの様に書けば良いのでしょうか？

---

sakuraxx

Answer 38

> ☆２回目以降の起動時にのみ存在したモジュール名。
> kernel32.dll
> C:\Windows\System32\kernel32.dll

これは絶対にあり得ません。
多分見間違えているんだと思います。
Excel.exe プロセスが動作するためには "kernel32.dll" は必須であり、このモジュールがロードされていなければ Excel.exe は起動できません。
また仮に起動後に "kernel32.dll" がアンロードされた場合は、Excel.exe プロセスはクラッシュします。
なので、初回起動時に "kernel32.dll" がロードされていないということは、絶対にありません。

以前の返信でも説明しましたが、この調査をお願いした意図は、初回起動時と２回目以降の起動時で、Excel.exe プロセス内にロードされるモジュールに差異があるか、ということです。
初回起動時と２回目以降の起動時でロードされるモジュール「の数」に差異がある場合、下記フィルタ条件で検出できるかもしれません。
(Excel.exe プロセスでロードに失敗したモジュールがある場合に、それを抽出してくれるフィルタ設定です。)

【フィルタ条件】
 "Process Name"     "is"        "EXCEL.EXE"     then    "Include"
 "Operation"        "is"        "Load Image"    then    "Include"
 "Result"           "is not"    "SUCCESS"       then    "Include"

Answer 39

-----------------------------------------------------
■試行１
初回起動時と２回目以降の起動時でロードされるモジュール「の数」に差異がある場合、
下記フィルタ条件で検出できるかもしれません。
(Excel.exe プロセスでロードに失敗したモジュールがある場合に、それを抽出してくれるフィルタ設定です。)
<フィルタ条件>
 [Process Name]  is     [EXCEL.EXE]  then [Include]
 [Operation]     is     [Load Image]  then [Include]
 [Result]       is not [SUCCESS]    then [Include]
≪解析結果≫
ロードに失敗したモジュールは、在りませんでした。

-----------------------------------------------------
■試行２
<フィルタ条件>
 [Process Name]  is [EXCEL.EXE] then [Include]
 [Operation]    is [ReadFile]  then [Include]

≪補足≫
予め用意する、初回起動時と２回目以降の起動時の PMLファイル採取を何度も用意し直し解析を試みたのですが、
[手順５]
ソートした"Modules:"リストボックスに"WindowsCodecsRaw.dll"が存在していることを確認します。
ここで"WindowsCodecsRaw.dll"が見つからない場合は、
上記 [手順２] に戻り、一つ前にリストされている"ReadFile"イベントに対して [手順５] までを繰り返し、
WindowsCodecsRaw.dllがリストされてる"ReadFile"イベントを探します。
・・・100以上回繰り返しても見つかりません…!?（初回起動時と２回目以降の起動時のもの）
念のため採取する直前に"WindowsCodecsRaw.dll"が存在していることを確認しておいたのですが上記で説明した通りです…原因不明。

止むを得ず解析用データの採取方法として、
初回起動時と２回目起動時のPMLファイルを採取(保存)する直前に、
Process Monitor ウィンドウに表示されている"ReadFile"イベントのうち、
一番最後のもの (タイムスタンプが一番最後のもの) をダブルクリックし、
その"ReadFile"イベントの"Event Properties"ダイアログを開き、
"WindowsCodecsRaw.dll"が存在していることを確認し、｢Copy All｣をクリックし→テキストファイル(メモ帳)として採取(保存)したデータを基に解析しました…拙かったでしょうか？。

≪解析結果≫
☆２回目以降の起動時にのみ存在したモジュール名。
 C:\Windows\SysWOW64\bcp47langs.dll
 C:\Windows\SysWOW64\edputil.dll

☆"Microsoft Corporation"以外の会社名のモジュール名。
初回起動時は、
Advanced Micro Devices, Inc.
 C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\aticfx32.dll
 C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\atidxx32.dll
 C:\Windows\System32\DriverStore\FileRepository\c0309377.inf_amd64_7ab08912e1e1da0a\atiuxpag.dll
Trend Micro Inc.
 C:\Windows\SysWOW64\tmumh\20019\TmMon\2.6.0.2023\tmmon.dll
 C:\Windows\SysWOW64\tmumh\20019\AddOn\7.30.0.1081\TmUmEvt.dll

２回目以降の起動時は、…初回起動時と同じ

以上

---

sakuraxx

Answer 40

ちょっと全体像が見えないのですが、要するに初回起動時に採取した PML ファイルでは、"WindowsCodecsRaw.dll" が見つからないということでしょうか？
だとしたら、やっと原因らしきものが見えてきかな。。。。と。
試しに、初回起動時に採取した PML ファイルに対して、下記フィルタを適用してみてください。
-------------------------------------------
【フィルタ条件】
 "Process Name"  "is"               "EXCEL.EXE"                   then    "Include"
 "Operation"        "is"               "Load Image"                  then    "Include"
 "Path"                "contains"     "WindowsCodecsRaw.dll"  then    "Include"
-------------------------------------------

上記フィルタ条件で "WindowsCodecsRaw.dll" のロード イベントが表示されないのであれば、そもそも "WindowsCodecsRaw.dll" モジュールのロード要求自体が発生していないことになります。
つまりこの問題は "WindowsCodecsRaw.dll" モジュールのバグが原因なのではなく、"WindowsCodecsRaw.dll" モジュールのロード要求を阻害する「何かの」処理が原因ということです。
もしこの推測が正しければ、"WindowsCodecsRaw.dll" モジュールのロード要求を阻害している原因を取り除けばこの問題は解決できると思います。

初回起動時に "WindowsCodecsRaw.dll" モジュールがロードされていないのであれば。。。。
Microsoft が提供している DLL モジュールのロードに失敗する大抵の原因は、3rd ベンダー製モジュールの干渉です。
ちょっと症状は異なりますが、以前にこのフォーラムで下記のようなケースがありました。
----------------------------------------
microsoft office ime 2010は動作を停止しました
https://social.msdn.microsoft.com/Forums/ja-JP/db6763a6-19b1-4500-8a95-1940dc46767e/microsoft-office-ime-2010?forum=imejp2010
----------------------------------------

上記はとても長いスレッドなので読むのが嫌になると思いますので要約しますと、大体以下のような感じになります。
(ちなみに、このスレッドで「回答」としてマークされているものは、全然関係ありません。)
----------------------------------------
<上記スレッドの概要>

[質問内容]
ノートパソコンを起動して、ログインした直後に１回だけ『microsoft office ime 2010は動作を停止しました』という、エラーメッセージが表示されます。
原因はなに？

[原因]
Intel Graphics 関連モジュールの "igd10umd32.dll" が IME 関連プロセスである "IMECMNT.EXE" にアタッチされていて、こいつが悪さをしていた。

[回避策]
"IMECMNT.EXE" プロセスに "igd10umd32.dll" モジュールを Injection する "igfxpers.exe" 止める。
----------------------------------------

つまり、問題現象としては「Office IME 2010 がクラッシュする」というもので一見マイクロソフト側の問題のように見えますが、実は Intel Graphics 関連モジュールが原因でした。。。。というオチです。
もしかしたら今回の問題も、これと類似することが起きているのかも。

というわけで、初回起動時に "WindowsCodecsRaw.dll" モジュールがロードされていないのであれば、下記事項の実施をお勧めします。
----------------------------------------
<試した方がいいこと>

☆ ATI (Advanced Micro Devices, Inc.) 関連のプロセスの停止
"msconfig.exe" ツールを起動し、ATI 関連のサービスおよびスタートアッププログラムをすべて停止させる。
(設定後は再起動してください。)
"msconfig.exe" ツールでの設定方法に関しては、下記サイトが参考になると思います。
++++++++++++++++++++++++++++++++++++++
【 不要なサービスを無効にする ( システム構成ユーティリティ ) 】
http://speedup-xp.com/win7org/18.html

【 不要なスタートアップを無効にする ( システム構成ユーティリティ ) 】
http://speedup-xp.com/win7org/17.html
++++++++++++++++++++++++++++++++++++++

☆ Trend Micro 社製セキュリティ対策ソフトの置き換え
上記 ATI 関連プロセスを止めても改善しない場合は、Trend Micro 社製セキュリティ対策ソフト (ウィルスバスター？) をアンインストールして、Windows Defender 等の別のセキュリティ対策ソフトに置き換えて、再度確認してみてください。

なお上記事項を試しても再発する場合は、"Process Monitor" で再度 PML ファイルを採取し、ATI および Trend Micro 関連のモジュールが "Excel.exe" プロセスにロードされていないことを確認してください。
(もし ATi や Trend Micro 関連のモジュールが存在するなら、きちんと設定できていない。。。ということです。)
----------------------------------------

Answer 41

<試した方がいいこと> …へのチャレンジ

☆ Trend Micro 社製セキュリティ対策ソフトの置き換え
処置:このアプリの機能で[停止]に設定しました。

☆ ATI (Advanced Micro Devices, Inc.) 関連のプロセスの停止
処置:"msconfig.exe"のサービスで、｢Microsoft｣のサービス以外を全て｢無効｣にしました。
処置:タスクマネージャーのスタートアップで、｢Advanced Micro Devices, Inc.｣関連を｢無効｣にしました。
そしてPCを再起動しました。

≪確認≫
Trend Micro Inc.系は、"Process Monitor"にロードされなくなりましたが、
Advanced Micro Devices, Inc.関連のモジュールは存在していた…消えそうにありません。
多分、｢AMD Settings｣と｢ADM Catalyst Install Manager｣をアンインストールすれば、"Process Monitor"にロードされなくなる様な気はするのですが自身がありません。

<フィルタ条件>
 [Process Name] is [EXCEL.EXE] then [Include]
 [Operation]    is [ReadFile]  then [Include]

☆"Microsoft Corporation"以外の会社名のモジュール名。
初回起動と２回目起動での比較を何度も試みたのですが毎回同じではありません…!?
事例(1)
kernel32.dll
mskeyprotect.dll

事例(2)
kernel32.dll
mscms.dll
mskeyprotect.dll
photometadatahandler.dll
windowscodecsext.dll
windowscodecsraw.dll

☆試しに、初回起動時と２回目起動時に採取した数本のPML ファイルに対して、下記フィルタを適用してみました。
<フィルタ条件>
 [Process Name]  is        [EXCEL.EXE]             then  [Include]
 [Operation]     is        [Load Image]            then  [Include]
 [Path]          contains  [WindowsCodecsRaw.dll]  then  [Include]

≪結果≫
確かにPMLファイルには"WindowsCodecsRaw.dll"が含まれているのですが、
リストアップ(ヒット)されませんでした…!?

---

sakuraxx

Answer 42

サービスやスタート アップでの起動を抑止する設定にしても「Advanced Micro Devices, Inc.関連のモジュールは存在していた」ということは、依然 Excel プロセスにちょっかいを出す AMD 関連の外部プロセスが存在しているということですが。。。
"Process Monitor" でログを採取する前に、ATi 関連のプロセスが起動してしていないことは確認しましたか？
確認してないのであれば、"Process Monitor" でログを採取する前に "Process Explorer" 等で起動中のプロセスを確認し、AMD 関連のプロセスが実行していた場合はそれを終了させてから試してみていただけますか？
("Process Explorer" の場合、メニューバーの <Process> → <Kill Process> で、現在ハイライトになっている選択中のプロセスを強制終了できます。)

で。。。。
初回起動時と２回目以降の起動時で "kernel32.dll" のロードに差異があるということですが、それは絶対にあり得ないのです。
つまり、確認すべきイベントを間違えている。。。。
私の説明がへたくそなのでよくわからないんだと思いますが、私もどう説明すれば伝わるのかわからない。。。
そこで提案ですが。。。
上記で説明した AMD (と Trend Micro) 関連プロセスを停止した状態での検証を実施しそれでも問題が起きる場合は、下記条件で初回起動時および２回目以降の PML ファイルを採取し、それをどこかのオンライン ストレージ上にアップしていただけますか？
それが可能であれば、私の方でそのログファイルを確認します。
ちなみに以前にお伝えした手順と採取方法が違うのは、余計なログを残さないためです。
(例えば、"Process Monitor" キャプチャ中に裏で H なサイトにアクセスしているとそれもログに残されてしまうので、それらを除外するための設定です。)
-----------------------------------------------
<PML ファイルの保存方法>

1. "Process Explorer" を起動し、今までと同じ手順で Excel 起動時の状態をキャプチャする。

2. Excel が起動し現象の有無を確認したらキャプチャを停止し、下記フィルタ条件を設定する。
++++++++++++++++++++++++++++++
【フィルタ条件】
 "Process Name"     "is"   "EXCEL.EXE"  then    "Include"
++++++++++++++++++++++++++++++

3. "Process Explorer" メニューバーの <File> → <Save...> をクリックしし、"Save To File" ダイアログで下記設定をし PML ファイルに保存する。
++++++++++++++++++++++++++++++
【"Save To File" ダイアログでの設定】

Events to save: Events displayed using current filter
                Also include profiling events

Format: Native Process Monitor Format (PML)
++++++++++++++++++++++++++++++
-----------------------------------------------

Answer 43

■Process Monitor収集の手順
--------------------------------
ウイルスバスター →停止
msconfig｢サービス｣:Microsoft以外を →全て無効にする
タスクマネージャー｢スタートアップ｣:Advanced Micro Devices, Inc. →無効にする
PCシャットダウン
PC電源を完全に切る(コンセントを抜く:約20分以上)
--------------------------------
PC起動
Process Explorer起動…AMD関連の停止を試みる
･Radeon Settings.exe Radeon Settings: Host Application  →killProcess …成功
･atiesrxx.exe        AMD External Events Service Module →killProcess …失敗:アクセスが拒否されました
Process Explorer終了
※atiesrxx.exeを停止できなかったが、次の.PML収集の作業を試みる
--------------------------------
初回起動
Process Monitor起動 →<フィルタ条件> [Process Name] is [EXCEL.EXE] then [Include]
Excel起動→Macro実行→Process Monitor収集停止 →Logfile707-1.PML 保存
                                              →Logfile707-1.txt (2018/04/13 17:46:03.9699202) 保存
撮影日時:正しくない
Excel終了
Process Monitor終了
--------------------------------
２回目起動
Process Monitor起動 →<フィルタ条件> [Process Name] is [EXCEL.EXE] then [Include]
Excel起動→Macro実行→Process Monitor収集停止 →Logfile707-2.PML 保存
                                              →Logfile707-2.txt (2018/04/13 17:51:38.8673281) 保存
撮影日時:正常
Excel終了
Process Monitor終了
--------------------------------
３回目起動
Process Monitor起動 →<フィルタ条件> [Process Name] is [EXCEL.EXE] then [Include]
Excel起動→Macro実行→Process Monitor収集停止 →Logfile707-3.PML 保存
                                              →Logfile707-3.txt (2018/04/13 17:55:44.4522164) 保存
撮影日時:正常
Excel終了
Process Monitor終了
--------------------------------
以上

---

sakuraxx

Answer 44

アップしていただいた PML ファイルはコピーしましたので、安全のため OneDrive の URL は削除してください。
PML ログの確認にはちょっと時間がかかりそうなので、しばしお待ちください。
なにかわかりましたら、別途返信いたします。

ちなみに。。。
AMD 関連のモジュールは相変わらずロードされているみたいですね。
この PC にインストールされている AMD Radeon のドライバは最新なのでしょうか？
下記サイトから Radeon の最新ドライバがダウンロード可能のようなので、確認してみてください。
-------------------------------------
Radeon、FirePro、APU、CPU、デスクトップ、ノートPC向けAMDドライバーおよびソフトウェアのダウンロード
https://support.amd.com/ja-jp/download
-------------------------------------

AMD Radeon ドライバが最新状態でも問題が起きるのであれば。。。。
可能ならば、一旦 Radeon ドライバをアンインストールして、Windows Inbox の標準グラフィックス ドライバに変更して問題現象が起きるか確認してみてください。
使い勝手が悪くなると思いますが、あくまでも一時的なテスト目的なので。
なお、Windows Inbox の標準グラフィックス ドライバでテストする際は、Excel プロセスに AMD 関連モジュールがロードされていないことを、きちんと確認してください。
(AMD 関連モジュールがロードされてしまっていると、標準グラフィックス ドライバでテストする意味がなくなってしまうので。。。)

Answer 45

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

現象:PC起動後に次の｢FileListUP｣を実行したら｢Nikon.NEF｣ファイルの撮影日時が正しく表示されません!?。

初回だけ撮影日時が取得できないのかと思ったら、タイムゾーン分ずれるということですか？それも初回だけ。
NEFファイルをダウンロードして、vbscriptでwhentakenを出すと-9Hになります。文字列で格納されてる撮影日時をローカル時間としてutcに変えて出してるようです。これが仕様なら、初回だけ、ということにはならないでしょう。excel vbaでだけ発生するなら、vbsで取り出せばよい。

Answer 46

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

あ ダメでした。"12 撮影日時=?2017-?04-?05 ??23:39"となっていました。

それは、エクスプローラのプロパティの撮影日時と異なる値なのですか？

Answer 47

<それは、エクスプローラのプロパティの撮影日時と異なる値なのですか？>
はい…異なります。詳細は下記の通りです。私のPC以外のPCでも同様の現象が発生しています(Windows10)。
Excel初回の起動時
CanonEos5DSR.CR2  2017/11/02 04:15:21
CanonEos5DSR.JPG  2017/11/01 12:15:21
NikonD300.NEF     2017/04/05 23:39:17
NikonD300.jpg      2017/04/05 07:39:17
NikonD810.NEF     2017/04/30 22:43:23
NikonD810.jpg      2017/04/30 06:43:23
２回目以降の起動時
CanonEos5DSR.CR2  2017/11/01 12:15:21
CanonEos5DSR.JPG  2017/11/01 12:15:21
NikonD300.NEF     2017/04/05 07:39:17
NikonD300.jpg      2017/04/05 07:39:17
NikonD810.NEF     2017/04/30 06:43:23
NikonD810.jpg      2017/04/30 06:43:23
当該画像ファイルをWebにアップしてあります…宜しければダウンロードしてご確認ください。
RAW写真の撮影日時が取得できない件 - OneDrive
https://onedrive.live.com/?authkey=%21AARFvGrNLbW4PKM&id=D0A96F3C83910E09%21194&cid=D0A96F3C83910E09

---

sakuraxx

Answer 48

Radeonの最新ドライバをインストール(AMD Software Ver18.2.1)しました。

Process Monitorで収集されるAMD関連ファイルが一本増えました (ProcessExplorerで停止できない)
-----------------------------------
Advanced Micro Devices, Inc.
C:\Windows\SysWOW64\amdihk32.dll ←★増えたdll
C:\Windows\System32\DriverStore\FileRepository\c0323831.inf_amd64_1212be4b9fe2386c\aticfx32.dll
C:\Windows\System32\DriverStore\FileRepository\c0323831.inf_amd64_1212be4b9fe2386c\atidxx32.dll
C:\Windows\System32\DriverStore\FileRepository\c0323831.inf_amd64_1212be4b9fe2386c\atiuxpag.dll
-----------------------------------
≪撮影日時≫
問題は解消されませんでした。
Radeon ドライバをアンインストールして、Windows Inbox の標準グラフィックス ドライバに変更してみる件…自身がありません(中止)。
参考:知人がPCを購入したので当該マクロの試行をさせて頂きましたが同様の現象が発生しました。
PC-NS700JAR-KS インテルUHD グラフィックス620(CPU内臓)

Answer 49

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

+16H　時間がずれるということですか？whentakenは　-9H+16H = +7H つまり、-7Hのタイムゾーンと勘違いしてる？（アメリカ・カナダ）山岳部標準時 - MST

excel vbaだけの話？

whentaken.vbs

set fso=createobject("scripting.filesystemobject")
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(fso.getparentfoldername(wscript.arguments(0)))
msgbox oFolder.ParseName(fso.getfilename(wscript.arguments(0))).extendedproperty("whentaken")

にnefファイルをドロップしても再現しません。

そちらではどうか。

Answer 50

whentaken.vbsのコードは、Excel-VBE(マクロ)で実行できません(実行エラーが発生します)。
現象確認用の｢Sample検索e.xlsm｣が次のサイトに投稿してあります…ダウンロードにて試行して頂ければと思います。
https://onedrive.live.com/?authkey=%21AARFvGrNLbW4PKM&id=D0A96F3C83910E09%21194&cid=D0A96F3C83910E09

---

sakuraxx

Answer 51

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

whentaken.vbsのコードは、Excel-VBE(マクロ)で実行できません(実行エラーが発生します)。

当たり前です。何がしたいのですか？

whentaken.vbsにnefファイルをドロップしても再現しません。

そちらではどうか。

Answer 52

初回起動時と２回目起動時時以降を比較すると、以下の２つファイルに関してロード状態の差異が見られます。
--------------------------------
<ロード状態に差異のあるモジュール>
☆ BCP47Langs.dll
☆ ncrypt.dll
--------------------------------

問題現象の症状から、"BCP47Langs.dll" の挙動の差異に起因している可能性が考えられます。
"BCP47Langs.dll" は、Locale および Language 関連処理に影響を与えると考えられますが、言語関連設定のレジストリ アクセスを調べると、下記レジストリ キーを読み込んだあたりから差異が見られます。
-----------------------------------
<差異が発生する直近のレジストリ キー>
HKLM\SOFTWARE\Microsoft\CTF\TIP\{0000897b-83df-4b96-be07-0fb58b01c4a4}\LanguageProfile\0x00000000\{0001bea3-ed56-483d-a2e2-aeae25577436}
-----------------------------------

上記キー アクセス直後、初回起動時と２回目以降起動時では、参照しているキーが異なっています。
-----------------------------------
<キー アクセスの差異>

☆ 初回起動時
HKCU\Software\Microsoft\Office\16.0\Excel\Options\LastUILang

☆ ２回目以降起動時
HKCU\Software\Microsoft\Office\16.0\Common\Experiment\excel\Language
-----------------------------------

以上のことから今回の問題現象は、レジストリに保持されている Office 言語関連の設定に差異が存在するために発生していると考えられます。
もっと細かくレジストリ アクセスをチェックしていけば、問題の引き金となるレジストリ キーを特定できるかもしれませんが、それよりかは自作されている VBA モジュールの方で、画像ファイルを読み込む前にロケールおよび言語関連設定を明示的に行う処理を追加すれば、本問題現象は解決できるような気がします。

追記
Office 言語設定での既定の言語が何になっているのか、確認したほうがいいかも。
[日本語] 以外の言語が既定として設定されているのであれば、[日本語] に設定して試してみるとか。

Answer 53

お馬鹿さん大変お世話になっております。
非力な私には「VBA モジュールに、画像ファイルを読み込む前にロケールおよび言語関連設定を明示的に行う処理を追加する」コードは分かりませんが、
Office 言語設定の確認をしてみました。
・編集言語の選択 →｢日本語｣が規定でした。
・表示言語の選択 →｢Microsoft Windowsと同じにする｣で合ったため、｢日本語｣を規定にしました。
≪RAW(NEF,CR2)ファイルの撮影日時の確認≫
今までと現象は同じでした（Excel初回起動時は正しくなく、２回目起動時からは正常でした）。

---

sakuraxx

Answer 54

VB とか VBA みたいな「超高級言語」は専門外なので、私には素人以下の知識しかないのですが。。。
(基本、C とアセンブリ以外は知らいない。)

とりあえず下記を参考に、初回起動時と２回目以降起動時で、地域と言語の設定が同じかどうかを確認してみては？
(私が提示できるのは↓こんな程度。。。)
---------------------------------------------------
Application.International プロパティ (Excel)
https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/application-international-property-excel

Application.LanguageSettings プロパティ (Excel)
https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/application-languagesettings-property-excel

LanguageSettingsオブジェクト
https://www.vba-ie.net/object/languagesettings.html

「疑惑の判定」の主審と、「Excel VBAの国際対応」
https://ameblo.jp/kanjizaibosatsu/entry-10575896984.html

すぐに役立つエクセルVBAマクロ集
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv212.html#4-4
13) 国地域に関する情報を取得する
---------------------------------------------------

(色んな言語に長けている佐祐理さんなら、こんなのはサクッと回答できると思いますが、このスレッドで過去になんかあったようなので、お返事してもらえるかは知りません。)

Answer 55

Officeの言語設定についての情報を取得して見ました。
結果:戻り値は、全て｢1041｣でした（言語ID → msoLanguageIDJapanese 1041 日本語 ）
Sub SampleLCID()
    Dim oLangSet As Object
    Set oLangSet = Application.LanguageSettings
    MsgBox "このアプリケーションに登録されたロケール ID は次のとおりです。" & vbCrLf & _
           "Excelインストールで選択した言語 - " & oLangSet.LanguageID(msoLanguageIDInstall) & vbCrLf & _
           "ユーザー インターフェイスの言語 - " & oLangSet.LanguageID(msoLanguageIDUI) & vbCrLf & _
           "ヘルプ言語                      - " & oLangSet.LanguageID(msoLanguageIDHelp) & vbCrLf & _
           "実行モード言語                  - " & oLangSet.LanguageID(msoLanguageIDExeMode) & vbCrLf & _
           "優先使用インターフェイス言語    - " & oLangSet.LanguageID(msoLanguageIDUIPrevious)
End Sub

---

sakuraxx

Answer 56

地域設定 (Application.International プロパティ) の方はどーでしたか？

Answer 57

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

<キー アクセスの差異>

☆ 初回起動時
HKCU\Software\Microsoft\Office\16.0\Excel\Options\LastUILang

☆ ２回目以降起動時
HKCU\Software\Microsoft\Office\16.0\Common\Experiment\excel\Language

つまり、excel vbaだけの話なのでは？

だったら、whentaken.vbsで取り出すようにすればよい。

Answer 58

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

<キー アクセスの差異>

☆ 初回起動時
HKCU\Software\Microsoft\Office\16.0\Excel\Options\LastUILang

☆ ２回目以降起動時
HKCU\Software\Microsoft\Office\16.0\Common\Experiment\excel\Language

つまり、excel vbaだけの話なのでは？

だったら、whentaken.vbsで取り出すようにすればよい。

意味が分かりません。

Answer 59

whentaken.vbs の意味がやっと分かりました…VBScriptと言う事ですね。
実はVBAは多少解るのですが、VBScriptは全く解りません…初めてのチャレンジです。
何となく理解…次の｢whentaken.vbs｣を作成して｢NikonD300.NEF｣をドロップ…成功(WorldTime表示)
set fso=createobject("scripting.filesystemobject")
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(fso.getparentfoldername(wscript.arguments(0)))
msgbox oFolder.ParseName(fso.getfilename(wscript.arguments(0))).extendedproperty("whentaken")

  …試行結果:VBScriptの値は「正しい」
ファイル               撮影日時(LocalTime)    撮影日時(WorldTime) …以下はVBAの取得データ
NikonD300.jpg  2017/04/05 07:39:17 2017/04/04 22:39:17 ←正しい撮影日時
NikonD300.NEF 2017/04/05 23:39:17 2017/04/05 14:39:17 ←JPGと同じなら正しいのですが

追記:VBScriptで取得できることは分かったのですが、Excelで取得できなければ課題が解決した事になりません。

Answer 60

地域設定 (Application.International プロパティ) の方はどーでしたか？

Sub Sample001()
    '現在の国/地域のコードを戻します(国際電話番号)。　　　  '戻り値
    Debug.Print Application.International(xlCountrySetting) '→ 81
    
    'MonthName関数(指定した月を示す文字列を戻します)
    Debug.Print MonthName(5)                                '→5月
    Debug.Print MonthName(5, False)                         '→5月
    Debug.Print MonthName(5, True)                          '→5
End Sub

---

sakuraxx

Answer 61

地域および言語設定は関係なかったみたいですね。
無駄なお手数をおかけしてしまって、申し訳ありませんでした。

で、もう一度 PML ファイルを調べ直してみましたところ、Excel 起動直後の NEF ファイル アクセス時の状態に、差異が見られました。
具体的には、Excel 起動直後の NEF ファイル オープン処理時において、初回起動では２回目以降起動に対して、以下のモジュールがロードされていませんでした。
----------------------------------------------
<NEF ファイル オープン処理時のモジュール差異>
☆ mscms.dll
☆ PhotoMetadataHandler.dll
☆ WindowsCodecsExt.dll
☆ WindowsCodecsRaw.dll
----------------------------------------------

上記モジュールは初回起動および２回目以降起動共に、Excel 起動時にメモリ上にロードされていますが、NEF ファイル オープン処理時において、２回目以降起動時ではロード状態にありますが、初回起動時ではアンロードされていました。
つまり Excel 初回起動時では、NEF ファイル アクセス時に一部の Codecs 関連 DLL が欠落しているために、この問題現象が発生している可能性が考えられます。

以上のことから今回の問題は、VBA 側で上記モジュールを明示的にロード状態にしておけば、もしかしたら改善できるかもしれません。
先の返信でも書いたように VBA に関しては、私は「ど素人以下の」知識しか持ちわせていませんが、ググった限りでは VBA でも DLL の明示的なロードは可能なようです。
とりあえず下記サイト等の情報を参考に、上記モジュール群を VBA 側で明示的にロード状態にさせることにより現象に変化がみられるか検証されてみては？
(対象 DLL をロードしそのモジュール ハンドルを解放しなければ、アンロードされることはないはずです。)
----------------------------------------------
Excel VBAの困った挙動 - DLLを利用する場合のまとめ - その3
https://ameblo.jp/blueskyame/entry-10237345291.html
----------------------------------------------

Answer 62

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

vbaからvbsを起動するか、vbaで、shell.applicationでなく、explorer objectを使えばよい。

念のため、

+16H　時間がずれるということですか？whentakenは　-9H+16H = +7H つまり、-7Hのタイムゾーンと勘違いしてる？（アメリカ・カナダ）山岳部標準時 - MST

コマンドプロンプトで

set TZ=JST-9
excel.exe

で確認。

Answer 63

ウィンドウズスクリプトプログラマさん こんにちは。
「あ ダメでした。"12 撮影日時=?2017-?04-?05 ??23:39"となっていました。」
これは誤情報です。（コードを書いておけば一目瞭然だったのですが、"shell.application"の中でGetDetailsOfを使って採取していました。）すみませんでした。

「vbaで、shell.applicationでなく、explorer objectを使えばよい。」
初回起動、2回目起動とも同一の時刻でした（使えます）。

「ファイル名をエクスプローラと同じ順序にソートする。」
 http://scripting.cocolog-nifty.com/blog/2007/12/post_3680.html
のコードを少し改造して  最初の質問文にある Sub FileListUP() に入れました。
（"I列"の表示に使っています。）
（動作確認は まだ１回しかしていませんけど、、）

Answer 64

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

shell.applicationはin process serverなのでexcelプロセス内で動く。explorerはout process serverなのでexcelの影響を受けない。そもそもプロパティハンドラはエクスプローラ用に作られているので、NEFのプロパティハンドラとexcelの相性が悪い、テストされてないということでしょう。

Answer 65

ery srowさん こんにちは、
「ファイル名をエクスプローラと同じ順序にソートする。」のコードを少し改造して、最初の質問文にある Sub FileListUP() に入れました。（"I列"の表示に使っています。）
　↓↓
宜しければ、試行された全てのコードを開示していただけないでしょうか、
私にも動作確認をさせてください。

---

sakuraxx

Answer 66

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

Excel VBAでミリ秒の時間を待つ。: Windows Script Programming

wscript.sleep 100

を

Application.Wait [NOW()+"0:00:00.1"]

に変える。

Answer 67

はい お願いします。
ie(internet explorer)とか sleepとか そのまま入れただけでテストが不十分です。
（"Declare PtrSafe ..."は"Option Explicit"の直下に。）
［注意!］フォルダを"C:\var\Test9\"に変更しています。

Option Explicit

'' Excel 2016 64bit での宣言
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

''「ファイル名をエクスプローラと同じ順序にソートする。」
''http://scripting.cocolog-nifty.com/blog/2007/12/post_3680.html
Sub Sample検索ie()
    Dim vPath As Variant: vPath = "C:\var\Test9\"  '要変更
    Dim Fso   As Object
    Dim F1    As Object
    Dim vName As Variant
    Dim WT    As Date
    Dim sDir  As String
    Dim R     As Long
    Dim Sap   As Object
    Dim fNum As Long   '追加
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Sap = CreateObject("Shell.Application")
   
    Worksheets("Sheet1").Select
    Cells.Clear '初期化
    MsgBox "ファイルの検索を開始します。", 64
    Range("C1").Value = "フォルダ"
    Range("D1").Value = "ファイル"
    Range("E1").Value = "作成日時"
    Range("F1").Value = "更新日時"
    Range("G1").Value = "アクセス日時"
    Range("H1").Value = "撮影日時"
    Range("I1").Value = "エクスプローラー"   '追加
    Cells.Font.Name = "ＭＳ ゴシック"
    Columns("E:I").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"  '変更
    Columns("E:I").HorizontalAlignment = xlLeft  '変更
    R = 2
    For Each vName In Sap.Namespace(vPath).Items
        WT = vName.ExtendedProperty("WhenTaken") '撮影日時の取得(WorldTime)
        sDir = Dir(vName.Path, 7)
        If sDir <> "." And sDir <> ".." Then
            If (GetAttr(vName.Path) And vbDirectory) <> vbDirectory Then
                Set F1 = Fso.GetFile(vName.Path)  'フルパス
                Cells(R, 3) = vPath               'フォルダ
                Cells(R, 4) = vName               'ファイル
                Cells(R, 5) = F1.DateCreated      '作成日時
                Cells(R, 6) = F1.DateLastModified '最終更新日時
                Cells(R, 7) = F1.DateLastAccessed 'アクセス日時
                If WT <> 0 Then
                    Cells(R, 8) = WT + TimeValue("9:00:00") '撮影日時(LocalTime)
                End If
                R = R + 1
            End If
        End If
    Next
    fNum = R
    If (fNum > 2) Then
       Dim ie As Object   '追加
       Dim ieFolder As Object
       Dim ieFolderItem As Object
       Dim fName As Variant
       Dim c As Range
       Dim dateTime As Variant
       Set ie = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}")  '追加
       ie.Navigate vPath
       R = 0
       Do While ie.Busy Or ie.ReadyState <> 4
          Sleep 200
          Debug.Print R
          R = R + 1
       Loop
  
       Set ieFolder = ie.Document.Folder
       For Each ieFolderItem In ieFolder.Items()
          If ieFolderItem.Type <> "ファイル フォルダー" Then
             fName = Fso.GetFileName(ieFolderItem.Path)
             Set c = Range(Cells(2, 4), Cells(fNum, 4)).Find(fName)
             If Not c Is Nothing Then
                dateTime = ieFolderItem.ExtendedProperty("WhenTaken")
                If Not IsEmpty(dateTime) Then
                   Cells(c.Row, 9) = dateTime + TimeValue("9:00:00")
                End If
                Set c = Nothing
             End If
          End If
       Next
       ie.Quit
       Set ieFolder = Nothing
       Set ie = Nothing
    End If
   
    Set F1 = Nothing
    Set Sap = Nothing
    Set Fso = Nothing
    Columns("A:Z").ColumnWidth = 1
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    MsgBox "◎◎◎処理完了◎◎◎", 64
End Sub

（いろんなフォルダでの テストをしていません。）
（長くなっているのは "For each"での順番が"Shell.Application"とieとで少し違っているせいです。）
謎のieについては、
http://scripting.cocolog-nifty.com/blog/2008/05/ie7_shell_ie_786d.html

[追加]2018-04-24 Tue. 19:49
思い出したことがあります。
「If ieFolderItem.Type <> "ファイル フォルダー" Then」
参考にしたページでは"ファイル フォルダ"になっていました。
Windowsのバージョンによって違うかもしれません。
（フォルダかどうかのチェックは別の書き方があったような、、）

Answer 68

© ウィンドウズスクリプトプログラマ - Windows Script Programmer 2018

---

if not folderitem.isfolder then

Answer 69

ほんとうだ、
    'If ieFolderItem.Type <> "ファイル フォルダー" Then
    If Not ieFolderItem.IsFolder Then

用事が重なってしまって朝寝坊していたい。
（今日の「ためしてガッテン」で解明されるみたいなので録画予約しとこっと。）

Answer 70

ery srowさんコードの提示ありがとうございました。
ウィンドウズスクリプトプログラマさんアドバイス感謝します。
謎のieの「new:{clsid}モニカ」は未知の領域ですが、Shell(Explorer)で使用する場合の意味合いは何となく解かった様な気がします。
Sample検索ieをまるごとコピーペにて試行させて頂きました。…成功:Excel初回の起動２回目以降の起動においても撮影日時は正常に表示されました。…BerryGood
掲題(質問)の件、お陰様で求めていた回答が得られました。
提示頂いたコードを基に私なりに整え直したコードを下記に提示いたします。
改良点などが有ればご教授よろしくお願いいたします。

Option Explicit

Sub Sample検索ie2()
'   Dim vPath As Variant: vPath = "C:\var\Test9\"
    Dim vPath As Variant: vPath = "D:\Test9\"
    Dim Fso As Object
    Dim F1 As Object
    Dim R As Long
    Dim ie As Object
    Dim ieFolder As Object
    Dim ieFolderItem As Variant
    Dim dateTime As Variant
    
    Worksheets("Sheet1").Select
    Cells.Clear '初期化
    MsgBox "ファイルの検索を開始します。", 64
    Range("C1").Value = "フォルダ"
    Range("D1").Value = "ファイル"
    Range("E1").Value = "作成日時"
    Range("F1").Value = "更新日時"
    Range("G1").Value = "アクセス日時"
    Range("H1").Value = "撮影日時"
    Range("I1").Value = "エクスプローラー"
    Cells.Font.Name = "ＭＳ ゴシック"
    Columns("E:I").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
    Columns("E:I").HorizontalAlignment = xlLeft
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ie = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}")
    ie.Navigate vPath
    Do While ie.Busy = True Or ie.readyState <> 4
        Application.Wait [NOW()+"0:00:00.1"]
    Loop
    
    R = 2
    Set ieFolder = ie.Document.Folder
    For Each ieFolderItem In ieFolder.Items()
        If Not ieFolderItem.IsFolder Then
            Set F1 = Fso.GetFile(ieFolderItem.Path) 'フルパス
            Cells(R, 3) = vPath               'フォルダ
            Cells(R, 4) = F1.Name             'ファイル
            Cells(R, 5) = F1.DateCreated      '作成日時
            Cells(R, 6) = F1.DateLastModified '最終更新日時
            Cells(R, 7) = F1.DateLastAccessed 'アクセス日時
            If Not F1 Is Nothing Then
                dateTime = ieFolderItem.ExtendedProperty("WhenTaken")
                If Not IsEmpty(dateTime) Then
                    Cells(R, 9) = dateTime + TimeValue("9:00:00") '撮影日時(LocalTime)
                End If
            End If
            Set F1 = Nothing
            R = R + 1
        End If
    Next
    ie.Quit
    Set Fso = Nothing
    Set ieFolder = Nothing
    Set ie = Nothing
    Set F1 = Nothing
    Columns("A:Z").ColumnWidth = 1
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    MsgBox "◎◎◎処理完了◎◎◎", 64
End Sub