Форумы HiProg.com - MS ACCESS, VBA, VB

ник: ГлазастыйМышь
Сталкнулся с такой ситуацией:
после поездки нужно было закатать фотографии от всех участников на один диск
Решение - в одну директорию в хронологическом порядке (переименовывание фоток через Picasa в формате времени съемки).
НО, у врех на фотиках разное время - и опять мешанина
Поэтому наваял процедурку которая эту проблемку решает.
Мож кому пригодится еще

Public Sub RetimeFoto(sPathInput As String) '======================================================================================= 'Приведение фотографий из различных источников к одному формату ' 'Вход: '   sPathInput  -   Путь к директории с файлами 'Remark: '   Предварительно необходимо выяснить время смещения каждого фотоаппарата от эталона '   и заполнить его. '--------------------------------------------------------------------------------------- 'Crete: '   Date:   2008-03-31 '   By:     Dekhtyar Konstantin '=======================================================================================     Dim objShellApp As Variant     Dim objFolder As Variant     Dim objItem As Variant     Dim sFileOutput As String     Dim iCount As Long On Error GoTo Err_Debug     Set objShellApp = CreateObject("Shell.Application")     Set objFolder = objShellApp.NameSpace(CStr(sPathInput)) ' взять директорию          For Each objItem In objFolder.Items()   ' пробег по всей директории (без учета вложенных)         If Right(objItem.Path, 4) = ".jpg" Then ' если фото, то работаем             Select Case objFolder.GetDetailsOf(objItem, 24) 'смотрим марку фотоаппарата                 Case "Canon PowerShot S80"                     ' берем дату (без секунд) из 25 свойства и последние 2 цифры (секунды) из 31                     ' плюс необходимое смещение в зависимости от конкретного фотика                     ' и представляем в виде год-месяц-число часы-минуты-секунды                     sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + 1 + (4 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)                 Case "Canon PowerShot A620"                     sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)                 Case "PENTAX Optio W30"                     sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (3 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)                 Case "Canon DIGITAL IXUS 50"                     sFileOutput = Format(CDate(objFolder.GetDetailsOf(objItem, 25)) + (2 / 24), "yyyy-mm-dd hh-nn") & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)             End Select                          If Not (objItem.Name = sFileOutput) Then    ' если новое имя не равно старому                 iCount = 0                 ' проверка на наличие файла с таким именем в данной директории                 ' при наличии добавлям в конец (порядковый №)                 Do Until objFolder.ParseName(CStr(sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString) & ".jpg")) Is Nothing                     iCount = iCount + 1                 Loop                      sFileOutput = sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString)                                  objItem.Name = sFileOutput  ' меняем имя файла             End If         End If     Next objItem          MsgBox "Процедура выполнена!", vbInformation + vbOKOnly, "Выполнено!" Exit_Here:     Set objItem = Nothing     Set objFolder = Nothing     Set objShellApp = Nothing     Exit Sub Err_Debug:     MsgBox Err.Description     Resume Exit_Here End Sub

ЗЫ. Временные смещения здесь даны для моего конкретного случая. Берутся путем нехитрых манипуляций: найти фотографии сделанные в одно время , но разными фотиками. Смотрим их время съемки и находим смещение относительно друг друга.
А дальше два варианта: известно точное время одной из фотографий (от нее и пляшем), или один из фотиков принимаем за эталон.