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

ник: ГлазастыйМышь
Ну вроде так,
в простом текстовом редакторе вставить и сохранить с разрешением .VBS

call RetimeFoto()   Function IIf(bTest, vTrue, vFalse)    If Eval(strIF) Then       IIf = vTrue    Else       IIf = vFalse    End If End Function   Sub RetimeFoto()  '=======================================================================================  'Приведение фотографий из различных источников к одному формату  '  'Вход:  '    'Remark:  '   Предварительно необходимо выяснить время смещения каждого фотоаппарата от эталона  '   и заполнить его.  '---------------------------------------------------------------------------------------  'Crete:  '   Date:   2008-03-31  '   By:     Dekhtyar Konstantin  '=======================================================================================      Set objShellApp = CreateObject("Shell.Application")      ' выбор директории     Set objFolder = objShellApp.BrowseForFolder(0, "Выберите папку с фотографиями.", &H200 + &H10 + &H40)           For Each objItem In objFolder.Items()   ' пробег по всей директории (без учета вложенных)            If lCase(Right(objItem.Path, 4)) = ".jpg" Then ' если фото, то работаем                       Select Case objFolder.GetDetailsOf(objItem, 24) 'смотрим марку фотоаппарата                  Case "Canon PowerShot S80"                      ' берем дату (без секунд) из 25 свойства и последние 2 цифры (секунды) из 31                      ' плюс необходимое смещение в зависимости от конкретного фотика                      ' и представляем в виде год-месяц-число часы-минуты-секунды                      FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + 1 + (4 / 24)                 Case "Canon PowerShot A620"                      FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24) '                Case "Canon PowerShot A620"  '                    FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (4 / 24)                 Case "PENTAX Optio W30"                      FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (3 / 24)                 Case "Canon DIGITAL IXUS 50"                      FileDate = CDate(objFolder.GetDetailsOf(objItem, 25)) + (2 / 24)                 Case Else                     FileDate = CDate(objFolder.GetDetailsOf(objItem, 25))             End Select                           sFileOutput = Year(FileDate) _                           & "-" & Right("00" & Month(FileDate), 2) _                           & "-" & Right("00" & Day(FileDate), 2) _                           & " " & Right("00" & Hour(FileDate), 2) _                           & "-" & Right("00" & Minute(FileDate), 2) _                           & "-" & Right(objFolder.GetDetailsOf(objItem, 31), 2)               If Not (objItem.Name = sFileOutput) Then    ' если новое имя не равно старому                  iCount = 0                  ' проверка на наличие файла с таким именем в данной директории                  ' при наличии добавлям в конец (порядковый №)                    bTest = objFolder.ParseName(CStr(sFileOutput & IIf(iCount = 0,"","(" & cStr(iCount) & ")") & ".jpg")) Is Nothing                 Do Until bTest                       iCount = iCount + 1                  Loop                        sFileOutput = sFileOutput & IIf(iCount > 0, "(" & iCount & ")", vbNullString)                         If lCase(Right(objItem.Name, 4)) = ".jpg" Then ' если в оригинале прописано расширение то добавляем                                       sFileOutput = sFileOutput & ".jpg"                 End If                 objItem.Name = sFileOutput  ' меняем имя файла              End If          End If      Next            MsgBox "Процедура выполнена!", vbInformation + vbOKOnly, "Выполнено!"  End Sub