照片也属于文件。
在VBA中通过访问文件对象File的DateLastModified、DateCreated、DateLastAccessed等属性可以获取文件的最后一次修改日期、文件的创建日期、以及文件的最后一次打开日期。
然后用Name语句可以将文件重命名,如果需要对文件夹中的所有照片都重命名,还需要添加遍历文件夹代码。
基于以上的知识,可以使用如下的代码将文件夹内的所有JPG照片按照修改日期重命名:
Sub QQ1722187970() Dim sPath As String '选择要遍历的文件夹 sPath = GetPath If Len(sPath) Then '开始遍历 Call EnuAllFiles(sPath, False) MsgBox "执行完毕!!!" End If End Sub Function GetPath() As String '声明一个FileDialog对象变量 Dim oFD As FileDialog Dim oFDFilter As FileDialogFilters ' '创建一个选择文件对话框 ' Set oFD = Application.FileDialog(msoFileDialogFilePicker) '创建一个选择文件夹对话框 Set oFD = Application.FileDialog(msoFileDialogFolderPicker) '声明一个变量用来存储选择的文件名 Dim vrtSelectedItem As Variant With oFD ' .Filters.Clear ' .Filters.Add "Excel文件", "*.xls*", 1 ' .Filters.Add "Word文件", "*.doc*", 2 '允许选择多个文件 .AllowMultiSelect = True '使用Show方法显示对话框,如果单击了确定按钮则返回-1。 If .Show = -1 Then '遍历所有选择的文件 For Each vrtSelectedItem In .SelectedItems '获取所有选择的文件的完整路径,用于各种操作 GetPath = vrtSelectedItem Next '如果单击了取消按钮则返回0 Else End If End With '释放对象变量 Set oFD = Nothing End Function '遍历文件夹及其子文件夹的通用过程, 'sPath参数表示要获取的文件夹的路径,bEnuSub可选参数表示是否遍历子文件夹,不提供表示不遍历子文件夹 '作者:Excel技术服务 'QQ:1722187970 '邮箱:1722187970@qq.com Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False) '定义文件系统对象 Dim oFso As Object Set oFso = CreateObject("Scripting.FileSystemObject") '定义文件夹对象 Dim oFolder As Object Set oFolder = oFso.GetFolder(sPath) '定义文件对象 Dim oFile As Object '如果指定的文件夹含有文件 If oFolder.Files.Count Then For Each oFile In oFolder.Files With oFile '输出文件所在的盘符 Dim sDrive As String sDrive = .Drive '输出文件的类型 Dim sType As String sType = .Type '输出含后缀名的文件名称 Dim sName As String sName = .Name '输出含文件名的完整路径 Dim sFilePath As String sFilePath = .Path '输出文件的上次修改时间 Dim dDLM dDLM = .DateLastModified '输出文件的上次访问时间 Dim dDLA dDLA = .DateLastAccessed '输出文件的创建时间 Dim dDC dDC = .DateCreated '输出文件的属性 Dim sATT sATT = .Attributes '如果文件是Word文件 If sName Like "*JPG*" Then '将文件的修改时间转换为文本 sDLM = VBA.Format(dDLM, "yyyymmdd hhmmss") '修改文件的名称 sName = VBA.Replace(sName, Mid(sName, 1, InStr(1, sName, ".") - 1), sDLM) '重命名文件的全名称 Name sFilePath As oFolder.Path & "\" & sName Else End If End With Next '如果指定的文件夹不含有文件 Else End If '如果要遍历子文件夹 If bEnuSub = True Then '定义子文件夹集合对象 Dim oSubFolders As Object Set oSubFolders = oFolder.SubFolders If oSubFolders.Count > 0 Then For Each oTempFolder In oSubFolders sTempPath = oTempFolder.Path Call EnuAllFiles(sTempPath, True) Next End If Set oSubFolders = Nothing End If Set oFile = Nothing Set oFolder = Nothing Set oFso = Nothing End Sub
发表评论