Ответить на сообщение

Вы отвечаете на сообщение:

ник: ГлазастыйМышь
Ну вроде так,
в простом текстовом редакторе вставить и сохранить с разрешением .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

Ваше имя:
Пароль:

Цитировать: [quote][/quote]	Код: [code][/code]
Жирный: [b][/b]	Наклонный: [i][/i]
URL: [url][/url]

Сообщение:
	Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru
Прикрепить:

Для вставки смайлов в текст щелкните по значку.

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