怎么提取照片拍摄时间

薄才多学

如何用代码提取到照片的拍摄时间，搜不到相关案例，还麻烦各位高手出手相助。谢谢先！
提取照片拍摄时间.rar (122.3 KB, 下载次数: 316)

2009-8-4 19:23 上传

点击文件名下载附件

传了两次都不成功，原来附件大了。重新找了几张。


[ 本帖最后由 薄才多学 于 2009-8-4 19:23 编辑 ]

HHAAMM

FileDateTime(地址)

HHAAMM

Private Sub CommandButton3_Click()
  Dim s, i
  s = Dir(ThisWorkbook.Path & "\*.jpg")
  i = 2
  Do While s <> ""
   ActiveSheet.Cells(i, 1) = Left(s, Len(s) - 4)
   ActiveSheet.Cells(i, 2) = FileDateTime(ThisWorkbook.Path & "\" & s)
   s = Dir()
   i = i + 1
  Loop
End Sub

zldccmx

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-8-4 下午 07:39:49

Sub zldccmx()
'引用 Microsoft Scripting Runtime
    Dim Fso As New FileSystemObject
    '  Set fso = CreateObject("Scripting.FileSystemObject")
    Dim Pat_H, Curfiles, Mf, Mfs(1 To 1000, 1 To 2)
    Pat_H = Application.GetOpenFilename("请选择一个目录 (*.jpg), *.jpg", , "请选择一个文件以确定目录")
    If Pat_H = False Then Exit Sub
    Pat_H = Left(Pat_H, InStrRev(Pat_H, "\"))
    Set Curfiles = Fso.GetFolder(Pat_H).Files
    i = 1
    For Each Mf In Curfiles
        Mfs(i, 1) = Mf.Name
        Mfs(i, 2) = Mf.DateLastModified & vbLf
        i = i + 1
    Next
    Sheets.Add.[A1].Resize(i - 1, 2) = Mfs
End Sub

zldccmx

呵呵，楼上的　& vbLf　不要
刚开始是使用字符串，所以加了　& vbLf

gdzqdq

用ACDSEE 生成文件表，导入电子表格即可。

zldccmx

根据你的附件
Private Sub CommandButton3_Click()
'引用 Microsoft Scripting Runtime
'    Dim Fso As New FileSystemObject
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Dim Pat_H, Curfiles, Mf, Mfs(1 To 1000, 1 To 2)
    Pat_H = ThisWorkbook.Path & "\"    'Application.GetOpenFilename("请选择一个目录 (*.jpg), *.jpg", , "请选择一个文件以确定目录")
    Set Curfiles = Fso.GetFolder(Pat_H).Files
    i = 1
    For Each Mf In Curfiles
        If UCase(Mf.Name) Like "*.JPG" Then
            Mfs(i, 1) = Left(Mf.Name, Len(Mf.Name) - 4)
            Mfs(i, 2) = Mf.DateLastModified
            i = i + 1
        End If
    Next
    [A2].Resize(i - 1, 2) = Mfs
End Sub

薄才多学

非常感谢各位大大！
真没想到这么快就有答案了，我先试试效果。

薄才多学

HHAAMM版主和老朽老师的代码都可以，不过提取的时间都是修改时间，不是照片拍摄时间。不知还有没有别的方法

HHAAMM

Private Sub CommandButton3_Click()
  Dim s, i
  Set fs = CreateObject("Scripting.FileSystemObject")
  s = Dir(ThisWorkbook.Path & "\*.jpg")
  i = 2
  Do While s <> ""
    Set f = fs.GetFile(ThisWorkbook.Path & "\" & s)
   ActiveSheet.Cells(i, 1) = Left(s, Len(s) - 4)
   ActiveSheet.Cells(i, 2) = f.DateCreated
   ActiveSheet.Cells(i, 3) = f.DateLastModified
   Set f = Nothing
   s = Dir()
   i = i + 1
  Loop
End Sub