Suprus
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добрый день!
Подскажите как реализовать, сортировку файлов по папкам (по <b>ВРЕМЕНИ</b> создания, не по дате, т.е чтобы скрипт создавал новые папки по формату ЧЧ-ММ и туда сортировал файлы).
Есть готовый скрипт "Сортирование файлов по папкам" by Petya V4sechkin. Можно его доработать?
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
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)
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
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
|
