手机图片QQ到硬盘,如何获得图片原始日期.

ning84

手机照片QQ方法传输到硬盘,日期改变了.

       Set Fso = New FileSystemObject
       Set oFile = Fso.GetFile(Rng)
       With oFile
           Debug.Print .DateCreated, .DateLastAccessed, .DateLastModified           
       End With


问,用什么方法能得到图片原始日期.

wanghan519

可以试着获取拍摄时间，在exif里
vba好像不好写，exceldna打包个xll可能方便点

wanghan519

或者别用qq传，手机上开个ftp，电脑上复制粘贴之后，修改时间应该不会变。。。

zpy2

http://e.anyoupin.cn/EData/?p=tools.ceshi.index/downloadTreeFile&file=/52/tt.zip

照片很多，想整理，如何根据拍摄时间去创建文件夹，然后自动放进对应文件夹

ning84

wanghan519 发表于 2023-6-20 04:27
可以试着获取拍摄时间，在exif里
vba好像不好写，exceldna打包个xll可能方便点

谢谢你的拍摄日期的回复，找到解决问题的方向。
在网上找了很长时间,都是用的FileSystemObject方法。无法获得图片的原始数据。FileSystemObject获得的日期只是手机QQ到硬盘的时间。
     
        sReturn = "文件属性： " & objfile.Attributes & vbCrLf         
        sReturn = sReturn & "文件创建日期： " & objfile.DateCreated & vbCrLf         
        sReturn = sReturn & "文件修改日期： " & objfile.DateLastModified & vbCrLf         
        sReturn = sReturn & "文件大小 " & FormatNumber(objfile.Size / 1024, -1)         
        sReturn = sReturn & "Kb" & vbCrLf



在硬盘中嫩够显示拍摄日期。

ning84

谢谢各位的回复。手机照片QQ到硬盘，简单方便使用效率高。比用数据线方法好多了。

错误删除垃圾照片，结果让人无语。没有办法将手机照片传送到硬盘。


手机文件传电脑，批量复制出现错误0x80030001-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/thread-1665809-1-1.html?_dsign=94a2e6f6

ning84

就想得到照片的拍摄日期。不会要学GPS(Exif)知识吧。一个菜鸟学习照片知识怎么学习知识越来越深，。

ExcelVBA打开文件夹并获取其中每个文件的GPS信息（Exif）（2） - 第一PHP社区  https://www.php1.cn/detail/ExcelVBA_DaKaiWe_2be51bb9.html

1. Sub OpenFromFolder()
   
2. 
   
3. On Error GoTo ExifError
   
4. 
   
5.     Dim strDump As String
   
6.     '## REQUIRES REFERENCE TO MICROSOFT SCRIPTING RUNTIME
   
7.     Dim fso As Scripting.FileSystemObject
   
8.     Dim fldr As Scripting.Folder
   
9.     Dim file As Scripting.file
   
10. 
    
11.     Set fso = CreateObject("scripting.filesystemobject")
    
12.     Set fldr = fso.GetFolder("E:\DNIT\Relatório Fotográfico\Fotos com dados GPS")  '#### Modify this to your folder location
    
13. 
    
14.     For Each file In fldr.Files
    
15.     '## ONLY USE JPG EXTENSION FILES!!
    
16.     Select Case UCase(Right(file.Name, 3))
    
17.         Case "JPG"
    
18.             With GPSExifReader.OpenFile(file.Path)
    
19. 
    
20.                strDump = strDump & "FilePath:                  " & .FilePath & vbCrLf
    
21.                strDump = strDump & "DateTimeOriginal:          " & .DateTimeOriginal & vbCrLf
    
22.                strDump = strDump & "GPSVersionID:              " & .GPSVersionID & vbCrLf
    
23.                strDump = strDump & "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal & vbCrLf
    
24.                strDump = strDump & "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal & vbCrLf
    
25.                strDump = strDump & "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal & vbCrLf
    
26.                strDump = strDump & "GPSSatellites:             " & .GPSSatellites & vbCrLf
    
27.                strDump = strDump & "GPSStatus:                 " & .GPSStatus & vbCrLf
    
28.                strDump = strDump & "GPSMeasureMode:            " & .GPSMeasureMode & vbCrLf
    
29.                strDump = strDump & "GPSDOPDecimal:             " & .GPSDOPDecimal & vbCrLf
    
30.                strDump = strDump & "GPSSpeedRef:               " & .GPSSpeedRef & vbCrLf
    
31.                strDump = strDump & "GPSSpeedDecimal:           " & .GPSSpeedDecimal & vbCrLf
    
32.                strDump = strDump & "GPSTrackRef:               " & .GPSTrackRef & vbCrLf
    
33.                strDump = strDump & "GPSTrackDecimal:           " & .GPSTrackDecimal & vbCrLf
    
34.                strDump = strDump & "GPSImgDirectionRef:        " & .GPSImgDirectionRef & vbCrLf
    
35.                strDump = strDump & "GPSImgDirectionDecimal:    " & .GPSImgDirectionDecimal & vbCrLf
    
36.                strDump = strDump & "GPSMapDatum:               " & .GPSMapDatum & vbCrLf
    
37.                strDump = strDump & "GPSDestLatitudeDecimal:    " & .GPSDestLatitudeDecimal & vbCrLf
    
38.                strDump = strDump & "GPSDestLongitudeDecimal:   " & .GPSDestLongitudeDecimal & vbCrLf
    
39.                strDump = strDump & "GPSDestBearingRef:         " & .GPSDestBearingRef & vbCrLf
    
40.                strDump = strDump & "GPSDestBearingDecimal:     " & .GPSDestBearingDecimal & vbCrLf
    
41.                strDump = strDump & "GPSDestDistanceRef:        " & .GPSDestDistanceRef & vbCrLf
    
42.                strDump = strDump & "GPSDestDistanceDecimal:    " & .GPSDestDistanceDecimal & vbCrLf
    
43.                strDump = strDump & "GPSProcessingMethod:       " & .GPSProcessingMethod & vbCrLf
    
44.                strDump = strDump & "GPSAreaInformation:        " & .GPSAreaInformation & vbCrLf
    
45.                strDump = strDump & "GPSDateStamp:              " & .GPSDateStamp & vbCrLf
    
46.                strDump = strDump & "GPSTimeStamp:              " & .GPSTimeStamp & vbCrLf
    
47.                strDump = strDump & "GPSDifferentialCorrection: " & .GPSDifferentialCorrection & vbCrLf
    
48. 
    
49.                Debug.Print strDump   '## Modify this to print the results wherever you want them...
    
50. 
    
51.            End With
    
52.        End Select
    
53.     NextFile:
    
54.         Next
    
55.         Exit Sub
    
56. 
    
57.     ExifError:
    
58.         MsgBox "An error has occurred with file: " & file.Name & vbCrLf & vbCrLf & Err.Description
    
59.         Err.Clear
    
60.         Resume NextFile
    
61. 
    
62.     End Sub

复制代码

perfect131

搞得 这么复杂，其实很简单
参考 7 楼，一般文件所有属性 都可以用这个方法 获取
https://club.excelhome.net/forum ... 08&pid=11219619

wanghan519

参考8楼，exif原来可以用shell.application来取

兰色的回忆

perfect131 发表于 2023-6-20 10:15
搞得 这么复杂，其实很简单
参考 7 楼，一般文件所有属性 都可以用这个方法 获取
https://club.excelhome ...

如果这个也能获取exif信息，那确实很牛逼