デジカメやスマホの写真ファイルやソレをレタッチした画像ファイルには、
撮影条件やGPS情報を記録したExifデータやレタッチソフトの追記情報が
画像データ以外に記録されている。
ガラケーの写真ファイルには携帯の機種型番と何らかの動作データらしきものが
コメントとして記述されていたりもする。
世は情報管理の時代である。
これら何がどれだけ書き込まれているかわからない付加情報を
JPEG画像ファイルからバッサリ切り落とすExcel VBAプログラムを作ってみた。
とりあえず、動作の内容や注意点は次回送りとして、
作成したプログラムを掲載する。
'構造体定義
Private Type Seg_Mark
ID(1) As Byte '1Byte x 2
Size(1) As Byte '1Byte x 2
End Type
'------------------
Sub EXIF_Cutter()
Dim S_Mark As Seg_Mark
Dim SOI_JFIF(4) As Long
Dim SOI(1) As Byte '1Byte x 2
Dim EOI(1) As Byte '1Byte x 2
Dim Data() As Byte
Dim K As Integer
Dim M As Long 'Max 2^31-1
Dim N As Long 'Max 2^31-1
Dim F_Len As Long 'Max 2^31-1
Dim F_Sys As Object
Set F_Sys = CreateObject("Scripting.FileSystemObject")
K = 5
SOI_JFIF(0) = &HE0FFD8FF
SOI_JFIF(1) = &H464A1000
SOI_JFIF(2) = &H1004649
SOI_JFIF(3) = &H7B000102 '300dpiなら&H2C010102
SOI_JFIF(4) = &H7B00 '300dpiなら&H2C01
Range("B5:F1000").Value = "" 'セル範囲をクリア
Folder$ = Range("B3").Value
If Dir(Folder$, vbDirectory) = "" Then
Range("B5").Value = Folder$ & " folder is not exist"
Exit Sub
ElseIf Dir(Folder$ & "\EXIF_Cut", vbDirectory) = "" Then
MkDir (Folder$ & "\EXIF_Cut")
End If
File$ = Dir(Folder$ & "\*.jpg") 'フォルダ内のjpgファイル名取得
Do While File$ <> "" 'フォルダにjpgファイルがある限り
N = 1
Cells(K, 2) = File$
If F_Sys.FileExists(Folder$ & "\EXIF_Cut\EC_" & File$) Then GoTo Skip_1
F_Len = FileLen(Folder$ & "\" & File$)
Open Folder$ & "\" & File$ For Binary As #1
Get #1, N, SOI()
If SOI(0) <> &HFF Or SOI(1) <> &HD8 Then GoTo Skip_2
N = N + 2
Open Folder$ & "\EXIF_Cut\EC_" & File$ For Binary As #2
Put #2, , SOI_JFIF()
Do
Get #1, N, S_Mark
M = 256 * CLng(S_Mark.Size(0)) + CLng(S_Mark.Size(1)) + 2
If S_Mark.ID(0) <> &HFF Then GoTo Skip_3
If S_Mark.ID(1) = &HC4 Then GoTo D_Copy 'Huffmann Table
If S_Mark.ID(1) = &HDB Then GoTo D_Copy 'Quantize Table
If S_Mark.ID(1) = &HDD Then GoTo D_Copy 'Restart Def.
If &HC0 <= S_Mark.ID(1) And S_Mark.ID(1) <= &HCF Then GoTo D_Copy 'SOFn
' If S_Mark.ID(1) = &HE2 Then goto D_Copy 'APP2
If S_Mark.ID(1) = &HDA Then Exit Do 'Scan Headder
GoTo Skip_0
D_Copy:
ReDim Data(M - 1)
Get #1, N, Data()
Put #2, , Data()
Skip_0:
N = N + M
Loop
Outside$ = ""
Do
Get #1, F_Len - 1, EOI()
If EOI(0) = &HFF And EOI(1) = &HD9 Then
M = F_Len - N
ReDim Data(M)
Get #1, N, Data()
Put #2, , Data()
Exit Do
End If
Outside$ = "Yes"
F_Len = F_Len - 1
If F_Len = N Then GoTo Skip_4
Loop
Cells(K, 3) = "Finish !"
If Outside$ = "Yes" Then Cells(K, 4) = "Outside data was deleted"
Close #1
Close #2
Next_File:
ReDim Data(0)
K = K + 1
File$ = Dir() '次のファイルを取得
DoEvents
Loop
Set F_Sys = Nothing 'Obj変数の開放
Exit Sub
'-----------------
Skip_1:
Cells(K, 3) = "- Skip -"
Cells(K, 4) = "EC_" & File$ & " is already exist"
GoTo Next_File
Skip_2:
Close #1
Cells(K, 3) = "- Skip -"
Cells(K, 4) = "No SOI [Not JPEG]"
GoTo Next_File
Skip_3:
Close #1
Close #2
Cells(K, 3) = "- Skip -"
Cells(K, 4) = "Lost Seg-Marker"
Kill Folder$ & "\EXIF_Cut\EC_" & File$
GoTo Next_File
Skip_4:
Close #1
Close #2
Cells(K, 3) = "- Skip -"
Cells(K, 4) = "Lost End-Marker"
Kill Folder$ & "\EXIF_Cut\EC_" & File$
GoTo Next_File
End Sub
このプログラムは以下のようにB3セルにExifなどの付加情報を削除したいJpegファイルを
収納したフォルダ名をドライブからのフルパスで記述して実行させることで、
そのフォルダ内の全ての拡張子.JPG（小文字の.jpgでも良い）のファイルに対して
付加情報削除処理を行うようにできている。
なお、付加情報削除処理と言ってもオリジナルのファイルは改変させず、
指定フォルダの中に”EXIF_Cut”というフォルダを作って、
その中に付加情報を削除したJpegファイルを元ファイルのアタマに”EC_”を付けた名前で
作成・収納する。
この時、既に”EXIF_Cut”フォルダが存在していれば、そこへファイルを追加収納する。
また、その中に作成しようとするファイルと同名のファイルが既に存在している時は、
そのファイルに対する処理はスキップし、上書きは行わない。
処理を実行すると上のようにB5セル以下に対象フォルダ内に見つかったJPEGが列挙され
C列にそのファイルの処理結果を、D列に注記が記述されて行く。
動作の内容や注意点のカンタンな説明は次回。
プログラムの使用は自己責任・ノークレームでお願いします！
なお、Windows7環境では動作していますが、Mac系では動かないかもしれません。
