Code VBA để lấy ngày chụp hình của file JPG

[thnghiachau]

Xin chào GPE,
Xin cho hỏi, mình có cách nào lấy được ngày chụp ảnh của file JPG/ vị trí chụp ảnh bằng VBA không ạ?
Cám ơn cả nhà nhiều!

 

[tigertiger]

Xin chào GPE,
Xin cho hỏi, mình có cách nào lấy được ngày chụp ảnh của file JPG/ vị trí chụp ảnh bằng VBA không ạ?
Cám ơn cả nhà nhiều!

Có cách này, theo link sau

DateCreated property (Visual Basic for Applications)

Sub ShowFileInfo(filespec)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(filespec)
    s = "Created: " & f.DateCreated
    MsgBox s
End Sub

 

[thnghiachau]

Có cách này, theo link sau

DateCreated property (Visual Basic for Applications)

Sub ShowFileInfo(filespec)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(filespec)
    s = "Created: " & f.DateCreated
    MsgBox s
End Sub

Không phải anh ơi

Em lấy ngày Date Taken chứ không phải lấy ngày Date Created
Và em cần lấy cái thông tin GPS nữa ah....
Cám ơn anh nhiều!

 

[tigertiger]

Không phải anh ơi
View attachment 238928
Em lấy ngày Date Taken chứ không phải lấy ngày Date Created
Và em cần lấy cái thông tin GPS nữa ah....
Cám ơn anh nhiều!

Ah, thế cái này liên quan đến file media, cụ thể cấu trúc dạng jpg rồi, bạn thử tham khảo cái này

Microsoft Windows 2000 Scripting Guide - Retrieving Extended File Properties

 

[HeSanbi]

Một File chỉ có thể lưu 3 thuộc tính thời gian sau:

.DateCreated - Ngày tạo
.DateLastAccessed - Ngày mở gần nhất
.DateLastModified - Ngày sửa gần nhất

Nếu ảnh được chụp thì có thể thuộc tính DateLastModified được chọn làm Date Taken

 

[thnghiachau]

Ah, thế cái này liên quan đến file media, cụ thể cấu trúc dạng jpg rồi, bạn thử tham khảo cái này

Microsoft Windows 2000 Scripting Guide - Retrieving Extended File Properties

Cám ơn bạn mình nghiên cứu liền đây...
Không có việc gì khó... chỉ sợ mần không được...

 

[ongke0711]

Thông tin đặc thù liên quan đến file ảnh lưu trong một chỗ gọi là EXIF. Nó lưu thông tin GPS, tốc độ chụp, tốc độ màn trập v.v...
Bạn xem link này: https://stackoverflow.com/questions...act-exif-data-from-shape-using-vba-excel-2010

 

[befaint]

Trong bài này có này:

Lấy tổng thời gian của video đưa vào ô sheet excel theo thứ tự

Muốn cho video chạy hết thời gian đã lấy vào ô các anh chị có cách nào chỉ giáo với ạ

www.giaiphapexcel.com

 

[thnghiachau]

Trong bài này có này:

Lấy tổng thời gian của video đưa vào ô sheet excel theo thứ tự

Muốn cho video chạy hết thời gian đã lấy vào ô các anh chị có cách nào chỉ giáo với ạ

www.giaiphapexcel.com

Cám ơn Bác...

 

[thnghiachau]

Thông tin đặc thù liên quan đến file ảnh lưu trong một chỗ gọi là EXIF. Nó lưu thông tin GPS, tốc độ chụp, tốc độ màn trập v.v...
Bạn xem link này: https://stackoverflow.com/questions...act-exif-data-from-shape-using-vba-excel-2010

Cám ơn Bác nhiều...
mình đã list down ra hết các thông tin trên file có dc, và Date Taken có nhưng thông tin GPS thì không thấy đâu cả, có gì bác xem giúp
Không biết chắc cái này không lấy dc thông tin GPS quá!!! hichic

 

[HeSanbi]

Thông tin GPS của tệp ảnh JPG

Excel VBA open folder and get GPS info (Exif) of each files in it

Guided by Jzz and David on another post, I discovered a VBA userform and modules that can be imported to Access DB or Excel that will ask you to select a file and it will display the EXIF external ...

stackoverflow.com

 

[huuthang_bd]

Cám ơn Bác nhiều...
mình đã list down ra hết các thông tin trên file có dc, và Date Taken có nhưng thông tin GPS thì không thấy đâu cả, có gì bác xem giúp
Không biết chắc cái này không lấy dc thông tin GPS quá!!! hichic

Muốn thông tin khác thì bạn tự nghiên cứu tiếp nhé.

Private Type ImgInfo
    Latitude As Double
    Longitude As Double
End Type
Function GetImgLocation(ByVal sFilePath As String) As ImgInfo
Dim aLat As Variant, aLng As Variant
Dim Lat As Double, Lng As Double
On Error Resume Next
With CreateObject("WIA.ImageFile")
    .LoadFile sFilePath
    aLat = .Properties("GpsLatitude")
    aLng = .Properties("GpsLongitude")
    If Not IsEmpty(aLat) Then
        Lat = (aLat(1) + aLat(2) / 60 + aLat(3) / 3600)
        If .Properties("GpsLatitudeRef") = "S" Then Lat = -Lat
        GetImgLocation.Latitude = Lat
    End If
    If Not IsEmpty(aLng) Then
        Lng = (aLng(1) + aLng(2) / 60 + aLng(3) / 3600)
        If .Properties("GpsLongitudeRef") = "W" Then Lng = -Lng
        GetImgLocation.Longitude = Lng
    End If
End With
End Function
Sub Test()
Dim Img As ImgInfo
Img = GetImgLocation(ThisWorkbook.Path & "\" & "IMG_1496.JPG")
MsgBox Img.Latitude & vbNewLine & Img.Longitude
End Sub

 

[thnghiachau]

Muốn thông tin khác thì bạn tự nghiên cứu tiếp nhé.

Private Type ImgInfo
    Latitude As Double
    Longitude As Double
End Type
Function GetImgLocation(ByVal sFilePath As String) As ImgInfo
Dim aLat As Variant, aLng As Variant
Dim Lat As Double, Lng As Double
On Error Resume Next
With CreateObject("WIA.ImageFile")
    .LoadFile sFilePath
    aLat = .Properties("GpsLatitude")
    aLng = .Properties("GpsLongitude")
    If Not IsEmpty(aLat) Then
        Lat = (aLat(1) + aLat(2) / 60 + aLat(3) / 3600)
        If .Properties("GpsLatitudeRef") = "S" Then Lat = -Lat
        GetImgLocation.Latitude = Lat
    End If
    If Not IsEmpty(aLng) Then
        Lng = (aLng(1) + aLng(2) / 60 + aLng(3) / 3600)
        If .Properties("GpsLongitudeRef") = "W" Then Lng = -Lng
        GetImgLocation.Longitude = Lng
    End If
End With
End Function
Sub Test()
Dim Img As ImgInfo
Img = GetImgLocation(ThisWorkbook.Path & "\" & "IMG_1496.JPG")
MsgBox Img.Latitude & vbNewLine & Img.Longitude
End Sub

Cám ơn bác nhiều...

Bài đã được tự động gộp: 8/6/20

Thông tin GPS của tệp ảnh JPG

Excel VBA open folder and get GPS info (Exif) of each files in it

Guided by Jzz and David on another post, I discovered a VBA userform and modules that can be imported to Access DB or Excel that will ask you to select a file and it will display the EXIF external ...

stackoverflow.com

Cám ơn Bác nhiều.
Đúng là cái em đang cần đây...

Bài đã được tự động gộp: 8/6/20

Muốn thông tin khác thì bạn tự nghiên cứu tiếp nhé.

Private Type ImgInfo
    Latitude As Double
    Longitude As Double
End Type
Function GetImgLocation(ByVal sFilePath As String) As ImgInfo
Dim aLat As Variant, aLng As Variant
Dim Lat As Double, Lng As Double
On Error Resume Next
With CreateObject("WIA.ImageFile")
    .LoadFile sFilePath
    aLat = .Properties("GpsLatitude")
    aLng = .Properties("GpsLongitude")
    If Not IsEmpty(aLat) Then
        Lat = (aLat(1) + aLat(2) / 60 + aLat(3) / 3600)
        If .Properties("GpsLatitudeRef") = "S" Then Lat = -Lat
        GetImgLocation.Latitude = Lat
    End If
    If Not IsEmpty(aLng) Then
        Lng = (aLng(1) + aLng(2) / 60 + aLng(3) / 3600)
        If .Properties("GpsLongitudeRef") = "W" Then Lng = -Lng
        GetImgLocation.Longitude = Lng
    End If
End With
End Function
Sub Test()
Dim Img As ImgInfo
Img = GetImgLocation(ThisWorkbook.Path & "\" & "IMG_1496.JPG")
MsgBox Img.Latitude & vbNewLine & Img.Longitude
End Sub

Hay quá....
Cám ơn Bác

 

[ndu96081631]

Hồi lâu rồi tôi có viết cái này:

Function FileDetail(ByVal FilePath As String, ByVal index As Long)
  On Error Resume Next
  Dim fldName As String, fleName As String
  With CreateObject("Scripting.FileSystemObject")
    fldName = .GetFile(FilePath).ParentFolder.Path
    fleName = .GetFile(FilePath).Name
  End With
  With CreateObject("Shell.Application")
    With .Namespace("" & fldName & "")
      FileDetail = .Getdetailsof(.ParseName("" & fleName & ""), index)
    End With
  End With
End Function

Cũng làm được nhiều chuyện lắm nha. Với trường hợp của bạn ta áp dụng:

=FileDetail(đường dẫn đến file, 12)

Con số 12 trong công thức là ý muốn nói đến cái "Date taken". Có thể thí nghiệm thay index từ 0 đến 320 xem nó ra cái gì. Hoặc muốn nghiên cứu xem từng index mang ý nghĩa cụ thể nào thì có thể chạy code này:

Private Sub AllDetails()
  Dim n As Long
  With CreateObject("Shell.Application").Namespace("C:\")
    For n = 0 To 320
      ActiveSheet.Cells(n + 2, 1) = n
      ActiveSheet.Cells(n + 2, 2) = .Getdetailsof(.Items, n)
    Next
  End With
End Sub

Đại khái vậy! Hy vọng có thể giúp ích được cho bạn

 

[thnghiachau]

Hồi lâu rồi tôi có viết cái này:

Function FileDetail(ByVal FilePath As String, ByVal index As Long)
  On Error Resume Next
  Dim fldName As String, fleName As String
  With CreateObject("Scripting.FileSystemObject")
    fldName = .GetFile(FilePath).ParentFolder.Path
    fleName = .GetFile(FilePath).Name
  End With
  With CreateObject("Shell.Application")
    With .Namespace("" & fldName & "")
      FileDetail = .Getdetailsof(.ParseName("" & fleName & ""), index)
    End With
  End With
End Function

Cũng làm được nhiều chuyện lắm nha. Với trường hợp của bạn ta áp dụng:

=FileDetail(đường dẫn đến file, 12)

Con số 12 trong công thức là ý muốn nói đến cái "Date taken". Có thể thí nghiệm thay index từ 0 đến 320 xem nó ra cái gì. Hoặc muốn nghiên cứu xem từng index mang ý nghĩa cụ thể nào thì có thể chạy code này:

Private Sub AllDetails()
  Dim n As Long
  With CreateObject("Shell.Application").Namespace("C:\")
    For n = 0 To 320
      ActiveSheet.Cells(n + 2, 1) = n
      ActiveSheet.Cells(n + 2, 2) = .Getdetailsof(.Items, n)
    Next
  End With
End Sub

Đại khái vậy! Hy vọng có thể giúp ích được cho bạn

Dạ Cám ơn Thầy nhiều...
Em đã làm dc rùi.
Gộp lại tấ cả bài giúp đỡ của thầy @ndu96081631 , @huuthang_bd , @ongke0711 , @tigertiger , @HeSanbi em đã hoàn thành.
Xin trân trọng cám ơn sự giúp đỡ nhiệt tình của mọi người .

 

[thnghiachau]

Hồi lâu rồi tôi có viết cái này:

Function FileDetail(ByVal FilePath As String, ByVal index As Long)
  On Error Resume Next
  Dim fldName As String, fleName As String
  With CreateObject("Scripting.FileSystemObject")
    fldName = .GetFile(FilePath).ParentFolder.Path
    fleName = .GetFile(FilePath).Name
  End With
  With CreateObject("Shell.Application")
    With .Namespace("" & fldName & "")
      FileDetail = .Getdetailsof(.ParseName("" & fleName & ""), index)
    End With
  End With
End Function

Cũng làm được nhiều chuyện lắm nha. Với trường hợp của bạn ta áp dụng:

=FileDetail(đường dẫn đến file, 12)

Con số 12 trong công thức là ý muốn nói đến cái "Date taken". Có thể thí nghiệm thay index từ 0 đến 320 xem nó ra cái gì. Hoặc muốn nghiên cứu xem từng index mang ý nghĩa cụ thể nào thì có thể chạy code này:

Private Sub AllDetails()
  Dim n As Long
  With CreateObject("Shell.Application").Namespace("C:\")
    For n = 0 To 320
      ActiveSheet.Cells(n + 2, 1) = n
      ActiveSheet.Cells(n + 2, 2) = .Getdetailsof(.Items, n)
    Next
  End With
End Sub

Đại khái vậy! Hy vọng có thể giúp ích được cho bạn

Thầy @ndu96081631 ơi,
khi em dùng strResult=.Getdetailsof(.ParseName("" & fleName & ""), 12) thì nó cho kết quả ghi lên cell là "06-‎08-‎2020 ‏‎10:53 AM"
nhưng khi em msgbox ra thì nó là như thế này

có mấy dấu "?" kỳ bí
và em dùng CDate(strResult) thì báo lỗi "Type Mismatch"...
Em làm đủ mọi cách mà không được ah....
Thầy giúp em với...

Cám ơn thầy nhiều.

 

[tigertiger]

Thầy @ndu96081631 ơi,
khi em dùng strResult=.Getdetailsof(.ParseName("" & fleName & ""), 12) thì nó cho kết quả ghi lên cell là "06-‎08-‎2020 ‏‎10:53 AM"
nhưng khi em msgbox ra thì nó là như thế này
View attachment 239134
có mấy dấu "?" kỳ bí
và em dùng CDate(strResult) thì báo lỗi "Type Mismatch"...
Em làm đủ mọi cách mà không được ah....
Thầy giúp em với...

Cám ơn thầy nhiều.

Ngoài cell thử hàm code xem ký tự lạ là code bao nhiêu

 

[huuthang_bd]

strResult = Replace(Replace(strResult, ChrW(8206), ""), ChrW(8207), "")

 

[thnghiachau]

strResult = Replace(Replace(strResult, ChrW(8206), ""), ChrW(8207), "")

Cám ơn anh nhiều...
đã bay ký tự lạ! mà sao em tìm không ra cái mả ký tự như anh nhỉ??? hichic

 

[tigertiger]

Cám ơn anh nhiều...
đã bay ký tự lạ! mà sao em tìm không ra cái mả ký tự như anh nhỉ??? hichic

xem bài #17 trên để biết cách sao