关于提取照片拍摄时间的疑问

tonyibm

我在论坛上面看到有关于提取照片拍摄时间的贴子，但是发现一个问题

用datecreated和datelastmodified,datelastaccessed等提取出来的都不对，

（直接贴图片好像贴不上去，老是提示“无效的图片文件”，只好用附件，）

下面张图片中的时间，也就是鼠标放在图片上方出现的提示信息中的“相片拍摄时间”才是真正的图片拍摄时间，而用鼠标右键点击的“属性”中的文件创建时间其实不是相片拍摄时间，

1.zip (13.75 KB, 下载次数: 75)

2009-9-7 11:16 上传

点击文件名下载附件

20080604223010-8604.zip (39.99 KB, 下载次数: 90)

2009-9-7 11:21 上传

点击文件名下载附件

从上面两张图片可以看出，第一张中的是真正的图片拍摄时间，是2009-9-5 11:46, 而在第二张图片，也就是鼠标右键点击的“属性”中的文件创建时间却是2009-8-31 11:39:38, 这个时间根本就不是相片拍摄时间，而文件修改时间2009-9-5 13:46:18是我修改此张相片的时间，这个时间是比前面的那个“相片拍摄时间”2009-9-5 11:46要晚的，

但是用datecreated提出来的是文件创建时间，datelastmodified提出来的是相片修改时间，而datelastaccessed提出来的是最后一次访问的时间，

不知道有没有什么办法可以取得相片的真正拍摄时间，

[ 本帖最后由 tonyibm 于 2009-9-7 11:28 编辑 ]

rover18

试试如下代码：
Private Function FindPicDate(PicFile As String) As String
      
    Dim bytes() As Byte
    Dim sLine() As String
    Dim fSize As Long, ExifDate As Long
    Dim i As Long, d As Long
    Dim ff      As Integer
    Dim Found   As Boolean
   
    ff = FreeFile
    fSize = FileLen(PicFile)
     
    If fSize > 1024 Then fSize = 1024 ' get 1st 1K of file.
    ReDim bytes(1 To fSize)

    Open PicFile For Binary As #ff
        Get #ff, 1, bytes
    Close ff
      
    sLine = Split(StrConv(bytes(), vbUnicode), Chr$(0))
   
    For i = 0 To UBound(sLine) ' does "Exif" exsist?
        ExifDate = InStr(1, sLine(i), "xif")    '这是本来应该是Exif
        If ExifDate > 0 Then
            Found = True
            Exit For
        End If
    Next i
        
    If Found = False Then Exit Function ' return nothing, "Exif" not found!
   
    For d = i + 1 To UBound(sLine) ' find first ":" in file
        ExifDate = InStr(1, sLine(d), ":")
        If ExifDate > 0 Then
            FindPicDate = sLine(d) ' return date string
            Exit For
        End If
    Next d
            
End Function

原文请参考这里：
http://www.vbforums.com/showthread.php?t=515109

tonyibm

这就是对的了，太强大了，多谢

rover18

上面那个解决办法不是最好的，下面这个是最完美的。
因为它直接提取了Date Picture Taken这个属性的信息。

Sub getVarDatePhotoTaken()
   
    'For a list of properties and their index numbers see _
    'http://www.microsoft.com/technet/scriptcenter/guide/sas_fil_lunl.mspx?mfr=true
   
    On Error Resume Next
    Dim objShell As Object, objFolder As Object, objFolderItem As Object, _
        strFolder As String, strFile As String, lngIndex As Long, varDateTaken As Variant
   
    strFolder = "D:"    'no trailing backslash though I don't know why!
    strFile = "DSC_0247.jpg"
    lngIndex = 25   'equals Date Photo Taken as given in the link above
    varDateTaken = Null
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(strFolder & "\")    'append the backslash
    Set objFolderItem = objFolder.ParseName(strFile)
    varDateTaken = objFolder.GetDetailsOf(objFolderItem, lngIndex)
    varDateTaken = Format(varDateTaken, "dd mmm yyyy hh:nn:ss")
   
    If Not IsDate(varDateTaken) Then varDateTaken = Null
    Debug.Print "Date photo taken = " & varDateTaken
   
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Sub

tonyibm

原帖由 rover18 于 2009-9-7 16:25 发表
上面那个解决办法不是最好的，下面这个是最完美的。
因为它直接提取了Date Picture Taken这个属性的信息。

Sub getVarDatePhotoTaken()
   
    'For a list of properties and their index numbers see _
  ...

这个也不错，但是有个问题，
取出来的时间没有秒，秒都是0，

rover18

原帖由 tonyibm 于 2009-9-7 17:01 发表



这个也不错，但是有个问题，
取出来的时间没有秒，秒都是0，

这个问题倒是没有注意到，呵呵

tigersgrowl

这段代码如何运行？

yinmonkey

rover18 发表于 2009-9-7 15:44
试试如下代码：
Private Function FindPicDate(PicFile As String) As String
      

怎么运行啊？是在VB里面嘛？能改成Excel VBA的嘛？还能读其他exif信息嘛？问题有点多，麻烦了！

yinmonkey

tonyibm 发表于 2009-9-7 16:13
这就是对的了，太强大了，多谢

你好，你实现这个功能了嘛？
怎么运行啊？是在VB里面嘛？能改成Excel VBA的嘛？还能读其他exif信息嘛？问题有点多，麻烦了！