昨年末にご紹介頂いた、「JpegExifクラス」の簡易版、をご存知ありませんか？

Question

VBAの参考書を丸写にしながら、17年ほど前から、
時系列・メモ追記の写真整理プログラムを自作して活用してきました。
このCodeは、「写真撮影日時＝ファイル更新日時（システム関数）」 とする方式でした。

最近では利用する画像が自分のCameraの *.jpg、だけでなく、
画像の圧縮、動画からの静止画の切り取り、WEBの公開の画像・イラストの取り込み、
PC画面のSnip画像など、*.jpg画像ではありますが多様化してきました。

そのため、「写真撮影日時＝ファイル更新日時」方式では不都合になり、
直接、写真撮影日時を読み出したいと思う機会が多くなっていました。
昨年、公開されている「 JpegExifクラス(ユーザー定義関数 )」を使う方法をご指導頂き、
自作プログラムに組み込んで利用できています。

この「JpegExifクラス」は、日付情報以外にも沢山の情報を書き出すプログラムで、
高度のテクニックを駆使して書かれた労作だそうです。
そのためか、このCodeを印刷して読み直していますが、
私のレベルでは、まだ半分以上がブラックボックスで、解読できていません。
これを簡略化したような、撮影日時だけに特化したSubや、ユーザ定義関数をご存知でしたら、
ご紹介頂ければありがたいです。

goosj12zy · Accepted Answer

’追加単純化撮影日時読出(VBA Code） 2017/06/11 zy

Option Explicit
Sub JpegExif撮影日時読出() 'myDate= *.jpg 写真の撮影日時
step01: '変数宣言、初期値の設定最近のｺﾝﾊﾟｸﾄｶﾒﾗファイル容量は 2,000,000_Byteを超える
Dim myA(3199) As Byte
Dim str As String ' 例：十進数の255を、Hex(255)で16進数化 OneByteの "FF"
' ASCII_Code記載の撮影日時の領域では、 70⇒&H46⇒F 50⇒&H32⇒2
Dim Tag As String ' BEでTag="4D4D"、LEでTag="4949"
Dim Offset As String '撮影日時記載のOffset位置変数
Dim ci As Long, ri As Long, rii As Long, riii As Long ' 配列変数の検索時の変数
Dim myDate As String ' 古写真、"0000/00/00 00:00:00" もある Date()の規定外値 As dateをAs Stringでｴﾗｰ回避
Dim ret As Integer: ret = 0 ' 各種 Tag確認変数
Dim sign As Integer: sign = 0 'ｲﾚｷﾞｭﾗｰ識別子
Dim myFile As String ' *.jpg名
step02: ' 3200バイト読込
myFile = Application.GetOpenFilename("C:(*.jpg),*.jpg") 'ｼｽﾃﾑ関数ﾌｧｲﾙ選択窓
If myFile <> "False" Then Open myFile For Binary As #1
Get #1, , myA '3200 Byte 読込
step03: '16進数（&H）の 2_Byteの Tag 作成 TIFF・JPEG・EXIF・Endian_Tag 確認
Tag = Right("00" & Hex(myA(0)), 2) & Right("00" & Hex(myA(1)), 2)
If Tag = "FFD8" Then sign = 0 '--- 蛇足で、"FFD8"を確認4下だけ。
Tag = Right("00" & Hex(myA(2)), 2) & Right("00" & Hex(myA(3)), 2)
If Tag <> "FFE1" Then
sign = 1 ' Exifﾌｧｲﾙではない。
GoTo step09 ' ｲﾚｷﾞｭﾗｰ処理へskip
End If
Tag = Right("00" & Hex(myA(12)), 2) & Right("00" & Hex(myA(13)), 2) ' Byte-Order(Data配置の扱いルース)確認
If Tag = "4D4D" Then ret = 1 ' myA(12 to 13) で TIFFﾌｧｲﾙ確認
If Tag = "4949" Then ret = 2 ' Bye_Order（ BE=4D4D ) or ( LE=4949 ）確認
For ri = 0 To 3198 Step 2 ' 2_Byte_Tagの作成写真撮影日時_Tag 検出
Tag = Right("00" & Hex(myA(ri)), 2) & Right("00" & Hex(myA(ri + 1)), 2)
If Tag = "9003" Or Tag = "0390" Then ' --- 撮影日時_Tag BEで zTa="9003"、LEで Tag="0390"
rii = ri ' 撮影日時Tag位置記録
GoTo step04 '撮影日時読出へ Skip
End If
Next ri
sign = 2 ' 撮影日時Tag無
GoTo step09 'ｲﾚｷﾞｭﾗｰ処理
step04: 'Tag="9003" or Tag="0390" 時の撮影日時情報読込
rii = rii - 1 ' myA(16 to 19)に、オフセット=8と記載 (起点+8)=(起点-1)+9 バイト番地 myA(9 to 12)読み取り。
If ret = 1 Then ' BEの撮影日時記載位置検出
Offset = Right("00" & Hex(myA(rii + 9)), 2) & Right("00" & Hex(myA(rii + 10)), 2) & Right("00" & Hex(myA(rii + 11)), 2) & Right("00" & Hex(myA(rii + 12)), 2)
End If
If ret = 2 Then ' -- LEの撮影日時記載位置検出
Offset = Right("00" & Hex(myA(rii + 12)), 2) & Right("00" & Hex(myA(rii + 11)), 2) & Right("00" & Hex(myA(rii + 10)), 2) & Right("00" & Hex(myA(rii + 9)), 2)
End If
riii = CLng("&H" & Offset) ' Offset読取起点十進数変換例 riii=700
step05: ' ASCII文字記載の撮影日時読出 19_Byte 連結 One_String
str = ""
For ci = 0 To 18
str = str & Chr(myA(riii + 12 + ci)) ' -- yyyy:mm:dd hh:mm:ss で 19_Byte
Next ci
Mid(str, 5, 1) = "/" ' --- ":" を "/" に変更（汎用Soft用日付情報利用可）
Mid(str, 8, 1) = "/"
myDate = str ' --- 読み出し例： myDate="2017/01/12 09:49:14"
If myDate = "0000/00/00 00:00:00" Then
sign = 3
GoTo step09 'ｲﾚｷﾞｭﾗｰ処理撮影日時 Tag？、日付 0 ？ As Dateでｴﾗｰ？(関数の限度外）
End If
GoTo step10 'FileCloseへ Skip
step09: 'ｲﾚｷﾞｭﾗｰ処理
If sign = 1 Then MsgBox "ｲﾚｷﾞｭﾗｰ理由 : FFE1無 Exifﾌｧｲﾙでない撮影日時=更新日時"
If sign = 2 Then MsgBox "ｲﾚｷﾞｭﾗｰ理由 : 撮影日時 Tag = 9003 or =3090無撮影日時=更新日時"
If sign = 3 Then MsgBox "ｲﾚｷﾞｭﾗｰ理由 : 読出撮影日付= 0000/00/00 00:00:00 撮影日時=更新日時"
myDate = FileDateTime(myFile) ' 組込関数更新日時表示
GoTo step10
MsgBox "ｲﾚｷﾞｭﾗｰ理由原因不明撮影日時 =更新日時"
myDate = FileDateTime(myFile)
step10: ' 終了
Close #1
MsgBox "ﾌｫﾙﾀﾞ名+ﾌｧｲﾙ名 = " & myFile & _
" 写真撮影日時 = " & myDate & _
" 結果確認 OK?"
End Sub

end-u · Answer

>どこでどんなエラーが出るんでしょうね？
>　#いや？そこは本筋じゃないんでどうでも良いです。
すみません言葉悪いですね
サンプルってことでエラー処理してないからパターンマッチングしないとそりゃエラーですわね-"-
If .test(buf) = True Then
　　ret = .Execute(buf)(0)
End If

ちなみに"Wia.ImageFile"は参照設定しないでも使えますよ
（環境：win7/office2010）

Sub sample()
　　test "C:\@tool\IMG_0001.JPG"
End Sub

Sub test(ByVal s As String)
　　Dim ret As String

ret = "error"
　　On Error Resume Next
　　With CreateObject("Wia.ImageFile")
　　　　.LoadFile (s)
　　　　ret = .Properties("36867")
　　End With
　　On Error GoTo 0
　　Debug.Print ret
End Sub

end-u · Answer

>しかし、JpegExifクラスと同様に、*.JpegであるがExifではない,
>ファイルは、エラーメッセージが出てしまいます。
どこでどんなエラーが出るんでしょうね？
　#いや？そこは本筋じゃないんでどうでも良いです。

他の方のお礼欄ですが
>その理由：「格納データのフォーマットにエラーがある」との判定で、
>除外され、アルバムには、この対象ファイルが読み出されない様です。
>EpegExifクラスはファイルから読み出す項目が多く、
>いまだに、どの項目でフォーマットエラーがあって除外されているのかは分かっていません。
>このようなエラーファイルでも、除外せずにアルバムに表示したいと思っています。
これが目的なら、クラスJpegExif通す前にjpgファイルを読み込めばいいんじゃないでしょうか。
アルバムに表示させるのは自前のコードですよね？

もしくは、元のコード
http://www.btinc.jp/vba_labo/study1.html
あまり変更せず使われてるなら
>If objJpeg.InitSet(fileName) >= 0 Then
ここが-11でもリストアップするようにすれば良いのでは？

Dim chk As Long
チェック用の変数追加して
chk = objJpeg.InitSet(fileName)
If chk >= 0 Or chk = -11 Then
：
とか？

goosj12zy · Answer

こんばんは。
WEB検索をしても、*.jpgファイルの構造や情報の読み出しは、一読ではなかなか理解しにくいですね。
しかし、個人的なお勉強の範囲であれば、大雑把に要点だけを知ってしまえば、
自分の言葉でVBA_Codingをして、Setp by Stepで淡々と進めれば、簡単に写真の撮影日時は読み出せますよ。

この*.jpgファイル情報は、DCF・CIPA・TIFF・Jpeg・Exifなどの公開されているルールに従って埋め込まれている。
この情報は、16進数(&H)の2_Byte(8bits*2)で構成されている、Tag、を目印に検索すれば容易に読み出せる。
一つのTagfフィールドは12_Byte 構成。その中で、Offset_情報は後半の4_Byteブロックに埋め込まれている。
この4_Byteブロックから、値へのオフセット情報を読み取る。

最近は、コンパクトデジカメの*.jpgファイルでも、3,000,000_Byte位の情報が埋め込まれている。
撮影日時情報は、先頭から3,000_Byte位までに埋め込まれている。
イメージとしては、バイト番地で、00 to 3199 を配列(myA)に読み込んだと仮定   Option Base 0;
Tag=myA(00 to 01) が"FFD8"があればJpegファイル。Tag=myA(02 to 03)が"FFE1"であればExifファイル。
Tag=myA(12 to 13) が"4D4D" or "4949"であればTIFFファイル。

なお、"4D4D" or "4949"は、Byte_Order（データを配列する規則）。
"4D4D"の時は、BL(Big_Endian)と言いい、"4949"の時はLE(Littele_Endian)と言う。
BEの時は、上位バイトを先頭に配置 例： "00 00 02 BC" 。
LEの時は、下位バイトを先頭に配置 例： "BC 02 00 00" 。 ここでは、LEはBE基準に直して、同一の値として扱う。

この3つのTagを確認後、撮影日時を示す、Tag="9003" or Tag="0390" のバイト番地を検索する。
このTagフィールド内に埋め込まれている、基準点からOffsetが示すバイト番地に、
撮影日時情報が書かれているので、バイト番地を読み取る。
このバイト番地から、撮影日時情報のバイト番地を特定し、日時を読み出す。
以上です。
容量が許せば、追加解答で、ご参考までに愚作「*.jpgファイルから撮影日時を読み取る」のVBA_Codeを添付してみます。
(かえって混乱させてしまったらごめんなさい)

end-u · Answer

#いやいやgoogle君情報鮮度あまりよくない..
#or私のchoiceがか;|

最近のOSならWIA.ImageFileで取れるらしいです
http://blog.livedoor.jp/hamu1962/archives/51466986.html
http://niwakan.blogspot.jp/2016/11/vba-wia-object-exif.html

end-u · Answer

『VBA　撮影日時？』ってgoogle君に尋ねると

[VBA] 指定した画像撮影日付+時刻を取得
http://hanatsunami.blogspot.jp/2013/05/vba.html
..辺りが簡単そうかな

Sub sample()
　　test "C:\@tool\IMG_0001.JPG"
End Sub

Sub test(ByVal s As String)
　　Dim buf As String
　　Dim ret As String
　　
　　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 2
　　　　.Charset = "SHIFT-JIS"
　　　　.LoadFromFile (s)
　　　　buf = .ReadText
　　　　.Close
　　End With
　　With CreateObject("VBScript.RegExp")
　　　　.Global = True
　　　　.Pattern = "\d{4}:\d{2}:\d{2} \d{2}:\d{2}:\d{2}"
　　　　ret = .Execute(buf)(0)
　　End With
　　Debug.Print ret
End Sub

siffon9 · Answer

興味があったのでソースをざっと見てみましたが

・不要なプロパティ定義
・Private Function readJPEGの画像サイズ取得部分
・Private Function readIFDのCASE中の不要な条件

のみが削除可能で、あまり簡略化できるようには思えません。
バイナリファイル中の複数データのデータの中から、データタイプを確認しながら特定のデータを探すという構造上、仕方がないように思えます。

Exif情報のデータフォーマットは知らないのでですが、写真撮影日時の情報がファイルの先頭から何バイト目というようには決まっていないのではないでしょうか？
それに対応するためのプログラム構造だと思います。

間違っていましたらご容赦を。

yokomaya · Answer

ごめんなさい。
おっしゃっている事はわからなくないのですが
不都合は何ですか？

仮にコードが判らなくても、使えるなら特に問題を
感じないのですが。
例えば、アドインとかVBAで書かれているのがあっても
中身考える人あまりいないと思うんです。

＞組み込んで利用できています。
これで充分に思うのですが。

昨年末にご紹介頂いた、「JpegExifクラス」の簡易版、をご存知ありませんか？

’追加 単純化撮影日時読出(VBA Code） 2017/06/11 zy

>どこでどんなエラーが出るんでしょうね？

>しかし、JpegExifクラスと同様に、*.JpegであるがExifではない,

こんばんは。

#いやいやgoogle君情報鮮度あまりよくない..

『VBA 撮影日時？』ってgoogle君に尋ねると

興味があったのでソースをざっと見てみましたが

ごめんなさい。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

’追加単純化撮影日時読出(VBA Code） 2017/06/11 zy

『VBA　撮影日時？』ってgoogle君に尋ねると