如何修改相片拍摄时间

aas12312

我水平实在有限，没有办法，恳求大神出现。帮忙

renahu

wcymiss 发表于 2015-2-9 13:18
楼主试试，下面的代码在我的电脑上修改成功：

自定义函数：调用方法：

老师，arrOldDate = StrConv(Format(strOldDate, "yyyy:mm:dd hh:nn"), vbFromUnicode) 获取的旧日期是空的，就是普通jpg文件

wxhnr

renahu 发表于 2015-12-3 12:37
老师，arrOldDate = StrConv(Format(strOldDate, "yyyy:mm:dd hh:nn"), vbFromUnicode) 获取的旧日期是空 ...

普通jpg文件哪有拍摄日期呢？

renahu

wxhnr 发表于 2015-12-4 07:58
普通jpg文件哪有拍摄日期呢？

谢谢老师提醒，成功了，不过我的拍摄日期的序号是3，不是25，可能不同相机拍的都不一样吧

张雄友

wcymiss 发表于 2015-2-9 13:18
楼主试试，下面的代码在我的电脑上修改成功：

自定义函数：调用方法：

修改一个是实现了，修改多个怎么调用？

ning84

'第25项是照片的拍摄日期，不知道不同的配置是否相同
strOldDate = objFolder.GetDetailsOf(objFolderItem, 25)

1. 
   
2. Function ModiPhotoDate(strPath As Variant, strFile As String, strNewDate As String)
   
3.     'strPath:文件所在文件夹名,必须是Variant类型
   
4.     'strFile:文件名（不包括路径）
   
5.     'strNewDate:要显示的日期时间，yyyy-mm-dd hh:nn格式,时间不写的话用原照片时间
   
6.    
   
7.     Dim objShell As Object
   
8.     Dim objFolder As Object
   
9.     Dim objFolderItem As Object
   
10.     Dim strOldDate As String
    
11.     Dim arrOldDate() As Byte
    
12.     Dim arrNewDate() As Byte
    
13.     Dim arrByte() As Byte
    
14.     Dim strNewFile As String
    
15.     Dim i As Long
    
16.     Dim j As Long
    
17.    
    
18.     '照片复件文件名
    
19.     strNewFile = Left(strFile, InStrRev(strFile, ".") - 1) & "复件." & Mid(strFile, InStrRev(strFile, ".") + 1)
    
20.    
    
21.     '获取照片的拍摄日期时间
    
22.     Set objShell = CreateObject("Shell.application")
    
23.     Set objFolder = objShell.Namespace(strPath)
    
24.     Set objFolderItem = objFolder.ParseName(strFile)
    
25.     '第25项是照片的拍摄日期，不知道不同的配置是否相同
    
26.     strOldDate = objFolder.GetDetailsOf(objFolderItem, 25)
    
27.     Set objFolderItem = Nothing
    
28.     Set objFolder = Nothing
    
29.     Set objShell = Nothing
    
30.    
    
31.     If Len(strNewDate) <= 11 Then
    
32.         strNewDate = Trim(strNewDate) & Format(strOldDate, " hh:nn")
    
33.     End If
    
34.    
    
35.     '日期在照片二进制中是"yyyy:mm:dd hh:nn:ss"格式存在，不知道不同格式的照片是否相同
    
36.     arrOldDate = StrConv(Format(strOldDate, "yyyy:mm:dd hh:nn"), vbFromUnicode)
    
37.     arrNewDate = StrConv(Format(strNewDate, "yyyy:mm:dd hh:nn"), vbFromUnicode)
    
38.    
    
39.     '读入照片的二进制数据
    
40.     With CreateObject("Adodb.Stream")
    
41.         .Open
    
42.         .Type = 1 'adTypeBinary
    
43.         .LoadFromFile strPath & "" & strFile
    
44.         arrByte = .read
    
45.         .Close
    
46.     End With
    
47.    
    
48.     '修改日期时间
    
49.     For i = 0 To UBound(arrByte)
    
50.         If arrByte(i) = arrOldDate(0) Then
    
51.             For j = 1 To UBound(arrOldDate)
    
52.                 If arrByte(i + j) <> arrOldDate(j) Then Exit For
    
53.             Next
    
54.             If j > UBound(arrOldDate) Then
    
55.                 For j = 0 To UBound(arrOldDate)
    
56.                     arrByte(i + j) = arrNewDate(j)
    
57.                 Next
    
58.             End If
    
59.         End If
    
60.     Next
    
61.    
    
62.     '二进制数据写入文件，创建日期和修改日期等是当前日期
    
63.     With CreateObject("Adodb.Stream")
    
64.         .Type = 1 'adTypeBinary
    
65.         .Open
    
66.         .Write arrByte
    
67.         .SaveToFile strPath & "" & strNewFile, 2 'adSaveCreateOverWrite
    
68.         .Close
    
69.     End With
    
70.    
    
71. End Function
    
72. 
    
73. Sub Main()
    
74.     Call ModiPhotoDate("C:", "1.JPG", "2014-12-01")
    
75. End Sub

复制代码

ning84

VBA 更改照片文件日期_百度搜索  http://www.baidu.com/s?ie=utf-8& ... 6%E6%97%A5%E6%9C%9F


不能运行









'Private Declare PtrSafe Function SetFileTime Lib "kernel32" (ByVal hFile As LongPtr, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As LongPtr
'Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hFile As LongPtr) As LongPtr
'Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Public Function SetFileDate(filePath As String, ByVal dtModified As Date) As Boolean
    Dim hFile As LongPtr
    Dim ftModified As FILETIME
   
    ' 将日期转换为FILETIME结构
    DateTimeToFileTime dtModified, ftModified
   
    ' 打开文件以便修改日期
    hFile = CreateFile(filePath, GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile <> 0 Then
        ' 设置文件修改日期
        If SetFileTime(hFile, ByVal 0, ftModified, ftModified) Then
            SetFileDate = True
        End If
        ' 关闭文件
        CloseHandle hFile
    End If
End Function

' 辅助结构
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

' 将Date转换为FILETIME
'Private Declare PtrSafe Sub DateTimeToFileTime Lib "kernel32" (ByVal lpDateTime As Date, lpFileTime As FILETIME)'
'使用这个函数，你可以将图片文件的修改日期更改为任何指定的日期：

Sub ChangePhotoDate()
    Dim photoPath As String
    Dim newDate As Date
   
    ' 图片文件路径
    photoPath = "C:\1.jpg"
   
    ' 新的日期
    newDate = DateSerial(2022, 1, 1) ' 示例日期：2022年1月1日
   
    ' 更改文件日期
    If SetFileDate(photoPath, newDate) Then
        MsgBox "文件日期已更改。"
    Else
        MsgBox "无法更改文件日期。"
    End If
End Sub