Допилить скрипт

[keks75]

Добрый день.
Есть идеальный скрипт, НО нужно еще чтобы сначала переименовывал файлы по дате в папке, а потом создавал папку по дате и переместил.
Скрипт делает- создает папку с датой создания файла и перемещает его.
Dim FSO, FldN, Fls, Fl, 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
DtN = FSO.BuildPath(FldN, GetDateName(Fl.DateLastModified))
If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

FlN = FSO.BuildPath(DtN, Fl.Name)
If FSO.FileExists(FlN) Then FSO.DeleteFile FlN, True
Fl.Move FlN
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

Спасибо

[keks75]

вот нашел вторую часть скрипта переименование в папках, но как объединить не могу разобраться.
papka = "c:\temp\"

Dim FilePath
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(papka)
'просматриваем папку с файлами
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
FilePath = FSO.BuildPath(Folder,SubFolder.Name)
FSO.MoveFile File, FilePath+"\"+SubFolder.Name+"_"+File.Name

Next
Next
Msgbox "ВСЕ!"