☰

VBScript 从照片中提取“拍摄日期”

tag-icon • tag-icon exif properties
VBScript 从照片中提取“拍摄日期”

我想知道是否可以使用 VBScript 提取图像文件的“拍摄日期”属性？我知道可以访问其他属性，例如创建日期、修改日期、访问日期，并且已经有了相同的工作脚本，但是可以访问拍摄日期属性吗？因为我相信它属于 EXIF 数据。

我找到了一些旧代码，但不幸的是，它们都不起作用。

如果有人知道我将非常感激。

特性

答案1

http://paulgrant.ca/code_image_details_gps.html

对此脚本进行微小的修改即可输出任何 EXIF 数据。

'PAULGRANT.CA 2011

Option Explicit
'On Error Resume Next

Const   ForWriting          = 2
Const   FileCreate          = True
Const   TristateTrue        = -1    'Unicode
Const   SecondsToWait       = 10
Const   YesNo               = 4
Const   IconQuestion        = 32

Dim WshShell, iCode, sCurrentFolderName, sOutputFileName
Dim oFS, oFolder, oTS, oImg, oFile
Dim iPos, sExt, sString

Set WshShell = WScript.CreateObject("WScript.Shell")
iCode = WshShell.Popup("Continue?", SecondsToWait, "Run This Script?", YesNo + IconQuestion)
If (iCode <> 6) Then
    WScript.Quit 1
End If

sCurrentFolderName      = WshShell.CurrentDirectory
sOutputFileName         = sCurrentFolderName & "\output.txt"

Set oFS         = WScript.CreateObject("Scripting.FileSystemObject")
Set oFolder     = oFS.GetFolder(sCurrentFolderName)
Set oTS         = oFS.OpenTextFile(sOutputFileName, ForWriting, FileCreate, TristateTrue)
Set oImg        = WScript.CreateObject("WIA.ImageFile")

For Each oFile In oFolder.Files

    iPos    = InStrRev(oFile.Name, ".")
    sExt    = Mid(oFile.Name, iPos)

    If (LCase(sExt) = ".jpg") Then

        sString = DoImage(oFile.Name)
WScript.Echo sString
        If (sString <> "") Then
            oTS.WriteLine sString
        End If

    End If

Next

oTS.Close

WScript.Echo "Done"

'FUNCTIONS

Function DoImage(sFileName)

    Dim i, j, v, s, sOutput, sPropertyName

    sOutput = ""

    oImg.LoadFile sFileName

   'This handles no attribs added by cybernard
    if oImg.Properties.count=0 then
   ' Do something about it
   wscript.echo "File:"&sFileName&" has no attributes"
    End if
   'End of cybernard add
    For i = 1 to oImg.Properties.Count

        sPropertyName = oImg.Properties(i).Name
        WScript.Echo "Prop:"&sPropertyName&"     "&oImg.Properties(i).Value
        If InStr(sPropertyName, "Gps") > 0 Then

            s = sPropertyName & "(" & oImg.Properties(i).PropertyID & ") = "

            If oImg.Properties(i).IsVector Then

                s = s & "[vector]"

                Set v = oImg.Properties(i).Value

                If sPropertyName = "GpsLatitude" Then

                    s = s & FormatCoords(v, oImg.Properties("GpsLatitudeRef").Value)

                ElseIf sPropertyName = "GpsLongitude" Then

                    s = s & FormatCoords(v, oImg.Properties("GpsLongitudeRef").Value)

                Else

                    For j = 1 To v.Count
                        s = s & v(j) & " "
                    Next

                End If

            Else
                s = s & oImg.Properties(i).Value
            End If

            sOutput = sOutput & s & vbCrLf

        End If

    Next

    DoImage = sOutput

End Function

Function FormatCoords(v,sRef)

    'On Error Resume Next

    Dim sCoords

    sCoords = v(1) & Chr(176) & v(2) & Chr(39) & v(3) & Chr(34) & sRef

    FormatCoords = sCoords

End Function

'End.

相关内容