LoginSignup
3
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

@Q11Q

VBAでWIAを使ってExifの撮影日付(DateTimeOriginal DatePhotoTaken)読み取る関数

Last updated at Posted at 2018-08-31

OS

Windows Me 以降
なお、スマホではなくコンデジ等を使う場合は必ず撮影前か、朝、時間を正確に合わせること。デジイチ等の高級機種は使ったことがないので不明だが、一般的にデジカメの時計は日差1秒くらいはあると思われる。時間を合わせないときはテレビ、電波時計等比較的正確な時計を撮影する。こうするとあとから秒数のズレで字間を計算して求める。

Exifを読み取るための参照設定

ライブラリ名(Win10 + Office2016)

Microsoft Windows Image Acquisition Library v2.0

ファイルの場所と名前

C:\Windows\System32\wiaaut.dll
VBA から WIA Object を使って Exif 情報を取得 - にわか管理者のあてにならん情報

通常は出てきていないので参照設定で探す

C:\Windows\System32\wiaaut.dll
ALT+F11 でVBEを開き、　ALT+T>>R で参照で C:\Windows\System32\ まで入れると Wiaで補完される。

WIAサービスはネットでは邪魔者だが、サービスで起動しているものとは名前は別

Winternals Defragmentation, Recovery, and Administration Field Guide
によると、サービスで起動している場合、Process IDでは
C:\Windows\System32\wiaservc.dll
と表示されるが、参照設定の対象ではない。

Datitime degitalized?(2019/1/13)

https://forums.adobe.com/thread/2389869
このフォーラムでは"Date time Digitized"で会話がなされているが、古い携帯などはこのタグのデータがなく、DatetimeOriginalしかない。このため、ここでは Exif Datetime Originalを撮影日付と判断している。
（2022/07/01追記）公式サイトの英語を見ると、"Date time Digitized"とは保存(stored)された日時と思われる。以前はRAWデータなど、メモリに書き込む時間を必要としていた。こうした機種では保存された日時は撮影した瞬間からずれてしまう。しかし、画素数句が少なく、1枚のファイルサイズが小さければ、この差は小さくなる。
なお、仕様を確認する方法がないが、DatetimeOriginalのIDはメーカーや機種でID番号が異なることがあるようだ。

すべてのExifデータを出すコード

Sub GetExifDateWithWIA()
'Windows 7 Later
'VBA for All MicrosoftOffice
'Need Reffernce Setting
Dim objWiaR As New WIA.ImageFile
Dim p As WIA.Property
Dim i As Long
objWiaR.LoadFile "DriveLetter:\*.JPG" '対象の写真ファイル
On Error Resume Next
Dim V_ID As Variant, V_Name As Variant, V_Value As Variant
For Each p In objWiaR.Properties
i = i + 1
V_ID = p.PropertyID
V_Name = p.Name
If p.PropertyID = 2 Or p.PropertyID = 4 Then
V_Value = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=2=緯度 ID=4=経度
Else
V_Value = p.Value
End If
Debug.Print V_ID & " " & V_Name & " " & V_Value
Next
On Error GoTo 0
End Sub

一応全部出してみて撮影日付をイミディエイトに表示する(2019/1/13)

GetExifPhotoTakenDateWithWIA
Sub GetExifPhotoTakenDateWithWIA()
'Windows 7 Later
'VBA for All MicrosoftOffice
'Need Reffernce Setting
' I searched Internet Web Articles about Date of Photo Taken, so there was two info "Date Time Original" or "Date Time Digitlized" is datetime photo taken.
'but I found that some Jpeg pics exif data do not have "date time degitlized". So I decided Datetime Phot Taken is Date time Original, Tag ID:= 36867, Tag Name:= "ExifDTOrig"

Dim objWiaR As New WIA.ImageFile
Dim p As WIA.Property
Dim i As Long
objWiaR.LoadFile "DriveLetter:\*.JPG"
On Error Resume Next
Dim V_ID As Variant, V_Name As Variant, V_Value As Variant
For Each p In objWiaR.Properties
i = i + 1
V_ID = p.PropertyID
V_Name = p.Name
If p.PropertyID = 2 Or p.PropertyID = 4 Then
V_Value = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=2=緯度 ID=4=経度
Else
V_Value = p.Value
End If
Debug.Print V_ID & " " & V_Name & " " & V_Value
Next
Debug.Print "撮影日付 is Exisf date Time Original. Value is  " & Replace(objWiaR.Properties("ExifDTOrig").Value, ":", "/", 1, 2, vbTextCompare)
On Error GoTo 0
End Sub

とりあえずExifから撮影日付(DateTimeOrijinal)を返す関数にしてみた

Function wiaExifDatePhotoTaken(strJpg As String) As Date
Dim objWiaR As New WIA.ImageFile
Dim p As WIA.Property, prps As WIA.Properties
Dim i As Long
objWiaR.LoadFile strJpg
Dim V_ID As Variant, V_Name As Variant, V_Value As Variant
Set prps = objWiaR.Properties
'  On Error Resume Next
'  For i = 1 To prps.Count
'  Debug.Print i, prps.Item(i).Name, prps.Item(i).Value
'  Next i
wiaExifDatePhotoTaken = Replace(prps.Item(14).Value, ":", "/", 1, 2, vbTextCompare)
On Error GoTo 0
If Err.Number = 0 Then
Exit Function
Else
Err.Clear
For Each p In objWiaR.Properties
i = i + 1
If p.PropertyID = 36868 Then
V_Value = Replace(p.Value, ":", "/", 1, 2, vbTextCompare)
   If IsDate(V_Value) Then
      wiaExifDatePhotoTaken = CDate(V_Value)
      Exit For
      wiaExifDatePhotoTaken = vbNull
   End If
End If
Next p
End If
End Function

PropertyTagDtOrg

コレクションは、1つまたは複数のオブジェクトを含むオブジェクトです。 コレクションは、同様のオブジェクトを効率的にグループ化する方法を提供します。 Windows Image Acquisition（WIA）は、DeviceInfoオブジェクトとItemオブジェクトのコレクションを提供します。

コレクションを使用して、コレクションに含まれるオブジェクトを列挙します。 たとえば、次のVBScriptの例では、DevicesメソッドからDeviceInfoオブジェクトのコレクションを取得し、For ... Eachループを使用してコレクションを反復処理します。
Tag 0x9003
Type PropertyTagTypeASCII
Count 20

参考文献

Windows Meの改良点

大きく分類してWindows Meの改良点は、以下の6つ

使い易さの向上

Windows 2000のユーザーインターフェイスの取り込み、Fast Boot(但し、BIOSなどの対応が必要)、OSとして休止状態/サスペンド対応

デジタルメディアへの対応

Media Player 7、Movie Maker、WIA(Windows Image Acquisition)、DVD Player(デコーダーは含まない)、My Picturesの機能拡張

システムの信頼性・保守性の向上

システムファイル保護(SFP/System File Protection)、システムの復元、ヘルプセンター

ネットワーク機能強化

ホームネットワークウィザード、インターネットゲーム

新しいハードウェアへの対応

UPnP、DV、IEEE1394など

その他

Cドライブ以外へのインストール、MS-DOS(CONFIG.SYSの中は空、MS-DOSコマンドの削除)の排除など
　もちろん、Internet Explorer 5.5やOutlook Express 5.5、Media Player 7など、インターネット上で既に公開しているものも含まれWindows Me固有とはいえない部分はあるが、これはいつものパターン。Microsoftのお家芸だ。

Windows Image Acquisition (WIA)ドライバーを使用してスキャンする旧

ホーム > サポート > プリンター/スキャナーのサポート情報 > DocuPrint CM200 b サポート情報 > スキャン機能 > Windows Image Acquisition (WIA)ドライバーを使用してスキャンする
Windows Image Acquisition (WIA)ドライバーを使用してスキャンする

コンテンツID（3413）

概要

Windows Image Acquisition (WIA)ドライバーを使用してスキャンをします。

手順

1枚の原稿を原稿ガラスに下向きにセットして原稿カバーを閉じます。
Windows®のペイントなどの描画ソフトウェアを起動します。
［ペイント］ボタン ＞［カメラまたはスキャナーから取り込み］（Windows XP、 Windows Server 2003、 Windows Server 2008、Windows Vista、Windows 8 および Windows Server 2012 の場合は［ファイル］ ＞［カメラまたはスキャナから取り込み］）をクリックします。
WIAウィンドウが表示されます。

WIA（Windows Image Acquisition）- アセンブラの魔女

WIAの概要
アーキテクチャ
WIAイベント
WIA関連のレジストリ
APIを使ったWIA制御
WIA Automation Layer

レジストリの制御が詳しい。公式が英語なので役立つ。しかしVBAの解説はない。

DocsWindowsDesktopAPIWIA >Windows Image Acquisition (WIA) - docs.microsoft.com
公式サイト（英語のみ）
プログラミング関係はこちらから
Windows Image Acquisition (WIA) docs.microsoft.com

WIAはVBSでも動く

公式を参考にすると、USB接続されているスキャナを探るVbScriptは以下のように書ける。しかしWindows10では動かない。Wia.Scriptでエラーになる。
Item.GetPropById method


const FirmwareVersion = 1026
const ConnectStatus = 1027
const DeviceTime = 1028
const PicturesTaken = 2050
const PicturesRemaining = 2051
const ExposureMode = 2052
const ExposureCompensation = 2053
const ExposureTime = 2054
const FNumber = 2055
const FlashMode = 2056
const FocusMode = 2057
const FocusManualDist = 2058
const ZoomPosition = 2059
const PanPosition = 2060
const TiltPostion = 2061
const TimerMode = 2062
const TimerValue = 2063
const PowerMode = 2064
const BatteryStatus = 2065
const Dimension = 2070
const HorizontalBedSize = 3074
const VerticalBedSize = 3075
const HorizontalSheetFeedSize = 3076
const VerticalSheetFeedSize = 3077
const SheetFeederRegistration = 3078
const HorizontalBedRegistration = 3079
const VerticalBedRegistraion = 3080
const PlatenColor = 3081
const PadColor = 3082
const FilterSelect = 3083
const DitherSelect = 3084
const DitherPatternData = 3085
const DocumentHandlingCapabilities = 3086
const DocumentHandlingStatus = 3087
const DocumentHandlingSelect = 3088
const DocumentHandlingCapacity = 3089
const HorizontalOpticalResolution = 3090
const VerticalOpticalResolution = 3091
const EndorserCharacters = 3092
const EndorserString = 3093
const ScanAheadPages = 3094
const MaxScanTime = 3095
const Pages = 3096
const PageSize = 3097
const PageWidth = 3098
const PageHeight = 3099
const Preview = 3100
const TransparencyAdapter = 3101
const TransparecnyAdapterSelect = 3102
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
const DeviceType = 5
Dim objWia
Dim objDeviceInfoCollection
Dim objDeviceInfo
Dim objRootItem
Dim objSelectedItems
Dim objItem
Dim PropValue
 
Set objWIA = CreateObject("Wia.Script")
 
Set objDeviceInfoCollection = objWia.Devices
 
For Each objDeviceInfo In objDeviceInfoCollection
    objRootItem=objDeviceInfo.Create()
    objSelectedItems=objRootItem.GetItemsFromUI(0, 0)
    For Each objItem In objSelectedItem
    PropValue = objItem.GetPropById(DeviceType)
    Next
Next

Requirements

Minimum supported client
Windows 2000 Professional, Windows XP [desktop apps only]
Minimum supported server
Windows Server 2003 [desktop apps only]
DLL Wiascr.dll (version 4.90 or later)

上記のコードはWin10では動かない

要求される環境をみると、Wia.Scriptで動くのはWindows server 2003までらしい。
そこで我々取材班は世界中の情報を探し、一路フランスに飛んだ
http://pmeindre.free.fr/axTest/TestWIA2.vbs
ここにヒントがあった。しかしApp.Traceというのがよくわからない。
そこでそれをWscript.Echo/Debug.Printに置き換えた。
USB接続でPrinter兼Scannerのようなデバイスをつないでいるとすると途中で選択画面が出て表示される。
このVBscriptは管理者権限でcmd.exeを起動し、 Cscript.exe で実行してください。
起動させると途中でDeviceの選択画面が出るので、それを選択してください。


Dim objWia 'AsNew WIA.DeviceManager
Dim objDeviceInfoCollection 'AsWIA.DeviceInfos
Dim objDeviceInfos 'AsWIA.DeviceInfos
Dim objDeviceInfo 'AsWIA.DeviceInfo

Dim objRootItem
Dim objSelectedItems
Dim objItem 'AsWIA.Item
Dim PropValue
Dim devMngr
Dim i, n 'AsInteger
Dim CommonDialog1 'AsWIA.CommonDialog
Dim p
Dim s 'AsString
Dim dev 'AsDevice
Set devMngr = CreateObject("WIA.DeviceManager")
Set CommonDialog1 = CreateObject("WIA.CommonDialog")
n = devMngr.DeviceInfos.Count
For i = 1 To devMngr.DeviceInfos.Count
  Wscript.Echo devMngr.DeviceInfos(i).Properties("Name").Value & vbTab & "(" & devMngr.DeviceInfos(i).DeviceID & ")", &HFF0000
Next
Set dev = CommonDialog1.ShowSelectDevice(UnspecifiedDeviceType, True)
For Each p In dev.Properties
    s = p.Name & "(" & p.PropertyID & ") = "
    If p.IsVector Then
        s = s & "[vector of data]"
    Else
        If p.Type = StringPropertyType Then
            s = s & """" & p.Value & """"
        Else
            s = s & p.Value
        End If
    End If
    Wscript.Echo s
Next
Dim dc 'As DeviceCommand
Dim bCanTakePicture
bCanTakePicture = False
For Each dc In dev.Commands
    Wscript.Echo "Command ID = " & dc.CommandID & vbTab & dc.Name & vbTab & "(" & dc.Description & ")"
    If dc.CommandID = wiaCommandTakePicture Then
        bCanTakePicture = True
        Wscript.Echo "Selected device supports the TakePicture command", &HFF0000 ', TRACE_OK
    End If
Next


Set objDeviceInfoCollection = devMngr.DeviceInfos

For Each objDeviceInfo In objDeviceInfoCollection
    For i = 1 To objDeviceInfo.Properties.Count
    objRootItem = objDeviceInfo.Properties(i)
  Wscript.Echo objDeviceInfo.Properties(i).PropertyID, objDeviceInfo.Properties(i).Name, objDeviceInfo.Properties(i).Type, objDeviceInfo.Properties(i).Value
    Next 'i
Next

VBA

End Sub
Sub Wiadeviceinfo()
Dim objWia As New WIA.DeviceManager
Dim objDeviceInfoCollection As WIA.DeviceInfos
Dim objDeviceInfos As WIA.DeviceInfos
Dim objDeviceInfo As WIA.DeviceInfo
Dim objRootItem
Dim devMngr
Dim objSelectedItems
Dim objItem As WIA.Item
Dim PropValue
Dim i, n As Integer
Dim CommonDialog1 As WIA.CommonDialog
Dim p
Dim s As String
Dim dev As Device
Set devMngr = CreateObject("WIA.DeviceManager")
Set CommonDialog1 = New WIA.CommonDialog
n = objWia.DeviceInfos.Count
For i = 1 To objWia.DeviceInfos.Count
  Debug.Print objWia.DeviceInfos(i).Properties("Name").Value & vbTab & "(" & objWia.DeviceInfos(i).DeviceID & ")", &HFF0000
Next
Set dev = CommonDialog1.ShowSelectDevice(UnspecifiedDeviceType, True)
For Each p In dev.Properties
    s = p.Name & "(" & p.PropertyID & ") = "
    If p.IsVector Then
        s = s & "[vector of data]"
    Else
        If p.Type = StringPropertyType Then
            s = s & """" & p.Value & """"
        Else
            s = s & p.Value
        End If
    End If
    Debug.Print s
Next
Dim dc 'As DeviceCommand
Dim bCanTakePicture
bCanTakePicture = False
For Each dc In dev.Commands
    Debug.Print "  Command ID = " & dc.CommandID & vbTab & dc.Name & vbTab & "(" & dc.Description & ")"
    If dc.CommandID = wiaCommandTakePicture Then
        bCanTakePicture = True
        Debug.Print "Selected device supports the TakePicture command", &HFF0000 ', TRACE_OK
    End If
Next


Set objDeviceInfoCollection = objWia.DeviceInfos

For Each objDeviceInfo In objDeviceInfoCollection
    For i = 1 To objDeviceInfo.Properties.Count
    objRootItem = objDeviceInfo.Properties(i)
  Debug.Print objDeviceInfo.Properties(i).PropertyID, objDeviceInfo.Properties(i).Name, objDeviceInfo.Properties(i).Type, objDeviceInfo.Properties(i).Value
    Next 'i
Next
End Sub

For Eachが断然早い

実はFor Each と For Iで出てくるデータは同じである。しかしFor iの方が遅い。
VBAでもVBSでも変わらない。

撮影日付 VBS版

上記のVBScriptが動いたのでプロパティの値を表示し、最後に撮影日付を表示する。
これもCscriptで実行してください。そうしないと、Wscript.Echoでいちいち止まってしまいます。

Dim objWia 'As New WIA.ImageFile
Dim p 'As WIA.Property
Dim i 'As Long
Set  objWia  = CreateObject("Wia.ImageFile")
objWiaR.LoadFile "DriveLetter:\*.JPG" '対象の写真ファイル
On Error Resume Next
Dim V_ID 'As Variant, V_Name 'As Variant, V_Value 'As Variant
For Each p In objWia.Properties
i = i + 1
V_ID = p.PropertyID
V_Name = p.Name
If p.PropertyID = 2 Or p.PropertyID = 4 Then
V_Value = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=2=緯度 ID=4=経度
Else
V_Value = p.Value
End If
Wscript.echo V_ID & " " & V_Name & " " & V_Value
Next
Wscript.echo "撮影日付 is Exisf date Time Original. Value is  " & Replace(objWia.Properties("ExifDTOrig").Value, ":", "/", 1, 2, vbTextCompare)
On Error GoTo 0

marioも生成できる

BMP画像も生成できます
VBScript + WIA を使って画像ファイルを作成する方法魚拓

3
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
3
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?