Тема: VBS: Перенос фото в папку с датой съемки
Доброго времени суток
Написал код для сортировки фото по дате съемки, но есть проблема не могу считать из фото дату съемки могу считать только дату изменения. Может кто сможет подсказать как считать "Дату съемок" фото
Dim FSO, FldN, Fls, Fl, D, DtN, FlN
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'If WScript.Arguments.Count = 0 Then
' MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"
' WScript.Quit
'End If
Do
Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Выберите каталог размещения файлов:", 0)
'Если пользователь не выбрал папку, завершаем приложение &H0001 + &H4000
If objFolder Is Nothing Then Exit Do
'Получаем путь к выбранной папке
objPath = objFolder.Self.Path
FoundColon = InStr(1,objPath,":",vbTextCompare)
'msgBox FoundColon
If FoundColon = 1 Then
MsgBox "Вы выбрали некорректную папку размещения файлов попробуйте еще раз!"
End if
Loop while(FoundColon = 1)
If objFolder Is Nothing Then
MsgBox "Не выбран каталог размещения файлов"
'DynamicContent_Div.InnerHTML = "Не выбран каталог размещения файлов"
Else
FldN = objPath
'FldN = WScript.Arguments(0)
If Not FSO.FolderExists(FldN) Then
MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
WScript.Quit
End If
Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
D = GetDateName(Fl.DateLastModified)
' MsgBox "File is " &Fl.Name &" " &D &" = " &Fl.DateLastModified
Dim tt
tt = "File is " &Fl.Name &" " &D &" = " &Fl.DateLastModified
ExitFromName = MsgBox (tt, 36, "Прекратить создание папки?")
'MsgBox ExitFromName
If ExitFromName = 6 Then
Exit For
End If
DtN = FSO.BuildPath(FldN, D)
If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN
FlN = FSO.BuildPath(DtN, Fl.Name)
If FSO.FileExists(FlN) Then
If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then
FSO.DeleteFile FlN, True
Fl.Move FlN
End If
Else
Fl.Move FlN
End If
Next
MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
WScript.Quit
End If
Private Function GetDateName(Dt)
Dim M, D
M = Month(Dt)
D = Day(Dt)
If M < 10 Then M = "0" & M
If D < 10 Then D = "0" & D
GetDateName = Year(Dt) & "-" & M & "-" & D
End Function