Excel-VBA 撮影日時の取得

質問

次の様な「For-Next」で撮影日時を取得しています。
"D:\Test1\"配下の"D3001.JPG"がヒットするまでループする…廻りくどい。
【やりたい事】
For-Nextを使わない。フルパス「"D:\Test1\D3001.JPG"」を指定して撮影日時を取得するには、どの様にソースコードを書けばよいのか分かりません。サンプルコードを提示いただければ有難いのですが、
誰かご教授宜しくお願いいたします。
'-----------------------------------
Sub 撮影日時表示()
Const sFile = "D3001.JPG" '…ターゲットファイル
Dim wFile As Variant
Dim wDate As Date
With CreateObject("Shell.Application")
For Each wFile In .Namespace("D:\Test1\").Items
wDate = wFile.ExtendedProperty("WhenTaken")
If wFile.Name = sFile Then
MsgBox wFile & " 撮影日時: " & wDate
Exit For
End If
Next
End With
End Sub
'-----------------------------------

回答No.7

emsuja · ベストアンサー

>撮影日付時刻の「日付」の表示に矛盾があります。
具体的にどう矛盾があるか提示していただけるとありがたかったのですが
当方がテストした Jpeg ファイルでは撮影したカメラで見られる日付と同じでした。

>yyyy:mm:dd hh:mm:ss ←年月日の区切りが":"で表示!?
年月日の区切りがコロンで表示される事がダメならば外付けで処理するのが一番です
少々長くなりますが VBA の改行がここでどう編集表示されるか判りませんので一行で書いて貼り付けます

MsgBox Mid(txtExifInfo, 1, 4) & "年" & Mid(txtExifInfo, 6, 2) & "月" & Mid(txtExifInfo, 9, 2) & "日" & Mid(txtExifInfo, 12, 2) & "時" & Mid(txtExifInfo, 15, 2) & "分" & Mid(txtExifInfo, 18, 2) & "秒"

>exifreaderにバグが有るのでしょうか、
バグでなく仕様と認識しています
使用者にとって exifreader 自体がブラックボックスですから、exifreader から提供されるデータはありがたく受け取って不満がある場合は使用者が対応するしかありません。

上手く使えば、使用したカメラの名前・露光時間・絞りの値・ISO感度・レンズの焦点距離等も取得できますが自己責任でどうぞ。

MsgBox objExif.Tag(Make) & " " & objExif.Tag(Model)
MsgBox objExif.Tag(ExposureTime)
MsgBox objExif.Tag(FNumber)
MsgBox objExif.Tag(ISOSpeedRatings)
MsgBox objExif.Tag(FocalLength)

お礼

ご指摘ごもっとも…感謝:有難くいただきます。
しかし、あるべき形式は例えば「yyyy/mm/dd hh:mm:ss」などと思います。
ご教授いただいた「Mid関数」、又は「Substituteメソッド」で個別に矛盾を回避したいと思います。尚、非力にて即応は難しいのですが機会を見て「exifreader」を自責で改良したいと思います。
emsujaさんへ、
ご多忙のところ大変お世話になりました。
具体的な説明をいただきすごく解り易かった。
本当に有難う御座いました。
以上

回答No.6

emsuja

#5 です

exifreader をインポートされたのでしょうか？
昨晩の文章の一件訂正です、

>但し最初の８行ほどはコメント化してください
これですが昨晩の検証時には私はクラスライブラリにカットアンドペーストで貼り付けていました、インポートの場合はコメント化の必要はありません。

それで

Sub 撮影日付時刻()
Dim objExif As New ExifReader
Dim txtExifInfo As String
objExif.Load "f:\test1\d3001.jpg"
txtExifInfo = objExif.Tag(DateTimeOriginal)
MsgBox txtExifInfo
End Sub

で、撮影時のデータは取得できますが処理の中で d3001.jpg なるファイルが本当に存在するかどうかのチェックが要ります。
それを簡単に書くとこんな感じでしょうか？

Sub 撮影日付時刻()
Dim objExif As New ExifReader
Dim txtExifInfo As String
On Error GoTo Errortrap
objExif.Load "f:\test1\d3001.jpg"
txtExifInfo = objExif.Tag(DateTimeOriginal)
MsgBox txtExifInfo
Exit Sub
Errortrap:
MsgBox "ファイルが見つかりません"
End Sub

ファイルの存在チェックは他にも色々書き方があると思いますが今は時間が無いので・・・
申し訳ございませんがこれも時間の都合で上記サンプルは Excel 2000 でしか動作確認しておりませんので悪しからず。

追伸： 質問者殿のサンプルではファイル名は完全に大文字・小文字の区別がされているようですが、上記サンプルではファイル名の大文字・小文字の区別はされていません。

補足

お世話になっております。
exifreaderをインポートして試行しました。正常に動作したと思えるのですが、撮影日付時刻の「日付」の表示に矛盾があります。
txtExifInfo = objExif.Tag(DateTimeOriginal)
MsgBox txtExifInfo
yyyy:mm:dd hh:mm:ss ←年月日の区切りが":"で表示!?
次の環境で試行しましたが何れも同じ結果でした。
Windows98-Excel2000
WindowsXP-Excel2003
WindowsVesta-Excel2007
exifreaderにバグが有るのでしょうか、
原因が分かれば有難いのですが・・・

回答No.5

emsuja

チョッと勘違いしてるかもしれませんが・・・

写真などの Jpeg ファイルの写真の「撮影」年月日を取得したいのでしょうか？
それとも Jpeg ファイルの「作成日付」を取得したいのでしょうか？
私の乏しい経験だと、Jpeg ファイルをメールに貼付して送ったりすると Jpeg ファイルの作成年月日がおかしくなる事があります、本当の撮影年月日を取得したい場合は Jpeg ファイル内部の Exif 情報を読み取る必要があります。

exifreader はいかがでしょうか？
ダウンロード先は
http://sourceforge.jp/projects/sfnet_exifclass/releases/

ここに Visual Basic Ver6 のクラスライブラリとして登録されています。
VB6 は Excel の VBA と互換性が高いのでほとんどそのまま使用できます、クラスライブラリとして読み込んでください、但し最初の８行ほどはコメント化してください
readme.txt ファイルの一番下に書かれているサンプルを実行すると Exif 情報の Jpeg 作成時の年月日時刻が取得できます。

あと ここの 2004/07/02 付けのところからダウンロードできるソースも役に立つかもしれませんが、こちらは Excel VBA での動作確認は取れていません、昔 VB6 で一度使った覚えがありますがかなり苦労した記憶があります、
http://www005.upp.so-net.ne.jp/cyber-catseye/e2csv/exif2csv00.html

補足

emsujaさんお世話になっております。
質問は、ファイルの作成日時とか更新日時ではなく、写真ファイルの「撮影日時」です。
ご紹介のURLを見ました。クラスライブラリはインポートまでは行ったのですが複雑すぎて使い方が今ひとつ分かりません…ギブアップです。
質問に添えたコードで撮影日時を取得できてはいるのですが指定フォルダ配下をターゲットファイルを探査（ループ）する無駄な処理を失くすしたシンプルなコードに改善したいのが今回の課題です。しかし改変のコードをどの様に書けばよいかが分かりません。
ターゲットファイルのフルパスを指定するような方法でループを廃止したい。
妙案が有ればご教授よろしくお願いいたします。

回答No.4

mitarashi

ちょっと気になったので、確認してみました。
当方の手持ちの写真で、
Windowsの機能で取得できる最終更新日　2010年12月1日、13:31:28.000
（CASIOの高速連射で撮影したためか、作成日の方が　2010年12月1日、13:45:10と遅い）
Exifから取得した撮影日時　2010:12:01 13:31:29と一秒違っていました。
特殊な事例かもしれませんが、ご参考まで。
Exif情報を読みたいときは、こちらをどうぞ。（我田引水）
http://okwave.jp/qa/q6464173.html

お礼

mitarashiさん情報有難うございます。
引き込まれ「clGdiplus.cls」をダウンロードして試行しました。
http://arkham46.developpez.com/articles/office/clgdiplus/
撮影日時などを取得できました。が、ClassModuleの大きすぎるのにビックリ。手軽に運用するには勿体なさすぎ今回は運用を見合す事とにしました。
別途機会を見て利用させていただきたいと思います。
以上

回答No.3

nda23

#2です。
記述ミスがありました。
誤：ハンドル = CreateFile(ファイル名, 0, 1, 0, 3, 128, 0)
正：ハンドル = CreateFile(sFile, 0, 1, 0, 3, 128, 0)

補足

nda23さんお世話になっております。
「(2)ちょっと複雑な方法」と「(3)マニアックな方法」は提示いただいたサンプルを若干修正する事で動作しました…内容も理解できました。どうも有り難うございました。
しかし、知りたいのは「撮影日時」を取得するコードです。
質問に添えたFor-Nextループ文で「撮影日時」を取得できてはいるのですが、無駄に思えるFor-Nextを廃止したいのですがコードの書き方が分からないので困っています。
妙案があればご教授よろしくお願いします。

回答No.2

nda23

(1)一番簡単な方法
FileDateTime(sFile)→最終更新日が返る。

(2)ちょっと複雑な方法
Dim ファイルシステム
Dim ファイル情報
Set ファイルシステム = CreateObject("Scripting.FileSystemObject)
Set ファイル情報 = ファイルシステム.GetFile(sFile)
MsgBox "作成日は" & ファイル情報.DateCreated & "です"
MsgBox "アクセス日は" & ファイル情報.DateDateLastAccessed & "です"
MsgBox "最終更新日は" & ファイル情報.DateLastModified& "です"

(3)マニアックな方法
Private Type FILETIME
　数値(1)　As Long
End Type
Private Type SYSTEMTIME
　年　　As Integer
　月　　As Integer
　曜日　As Integer
　日　　As Integer
　時　　As Integer
　分　　As Integer
　秒　　As Integer
　ミリ秒　As Integer
End Type
Private Declare Function FileTimeToSystemTime Lib "KERNEL32" _
　(ファイル時刻 As FILETIME, システム時刻 As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "KERNEL32" _
　(世界協定時刻 As FILETIME, 地域時刻 As FILETIME) As Long
Private Declare Function GetFileTime Lib "KERNEL32" _
　(ByVal ハンドル As Long, 作成日 As FILETIME, _
　 アクセス日 As FILETIME, 最終更新日 As FILETIME) As Long
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" _
　(ByVal パス名 As String, ByVal アクセスモード As Long, _
　 ByVal 共有モード As Long, ByVal 継承属性 As Long, _
　 ByVal 作成方式 As Long, ByVal ファイル属性 As Long, _
　 ByVal テンプレート As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" _
　(ByVal ハンドル As Long) As Long

Sub 撮影日時表示()
Const sFile = ～
Dim ハンドル　　As Long
Dim I　　　　 As Long
Dim 内部日付(2) As FILETIME
Dim 表示日付(2) As String

ハンドル = CreateFile(ファイル名, 0, 1, 0, 3, 128, 0)
If ハンドル <> -1 Then
　GetFileTime ハンドル, 内部日付(0), 内部日付(1), 内部日付(2)
　CloseHandle ハンドル
　For I = 0 To 2
　　Dim ファイル日付　　As FILETIME
　　Dim システム日付　　As SYSTEMTIME
　　FileTimeToLocalFileTime 内部日付(I), ファイル日付
　　FileTimeToSystemTime ファイル日付, システム日付
　　表示日付(I) = CStr(システム日付.年) _
　　　　& "/" & Format(システム日付.月, "00") _
　　　　& "/" & Format(システム日付.日, "00") _
　　　　& " " & Format(システム日付.時, "00") _
　　　　& ":" & Format(システム日付.分, "00") _
　　　　& ":" & Format(システム日付.秒, "00") _
　　　　& "." & Format(システム日付.ミリ秒, "000")
　Next
End If
MsgBox "作成日は" & 表示日付(0) & "です"
MsgBox "アクセス日は" & 表示日付(1) & "です"
MsgBox "最終更新日は" & 表示日付(2) & "です"
End Sub

回答No.1

bin-chan

「VB6 ABC.exe ExtendedProperty」でググるとトップに出てくるであろう知恵袋のベストアンサーが良さそうです。
ファイルを狙い撃ちしてます。

補足

bin-chanさん早々の回答有難うございました。
下記URLを参考に試行してみたのですが結果を出せませんでした。

http://msdn.microsoft.com/en-us/library/bb774055(VS.85).aspx
ExtendedProperty メソッド
試行しましたがコンパイルエラーが発生しました。
を非力にて解消する事ができませんでした(ギブアップ)。

http://homepage2.nifty.com/pasocon/shell/folder/getdetailsof.html
GetDetailsOf メソッド
これは次の書き方で試行は成功しました。しかしながら、「秒」が取得できないため断念しました。
Sub 撮影日時取得()
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("D:\Test1")
If (Not objFolder Is Nothing) Then
Dim objFolderItem
Set objFolderItem = objFolder.ParseName("D3001.JPG")
If (Not objFolderItem Is Nothing) Then
MsgBox "更新日時: " & objFolder.GetDetailsOf(objFolderItem, 3)
MsgBox "作成日時: " & objFolder.GetDetailsOf(objFolderItem, 4)
MsgBox "アクセス: " & objFolder.GetDetailsOf(objFolderItem, 5)
MsgBox "撮影日時: " & objFolder.GetDetailsOf(objFolderItem, 12)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub