Hugo121
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Demon L
Ну вот такой полуфабрикат получился, худо-бедно работает.
Есть привязка к количеству символов в путях (c:\Temp\IN), высчитай под свои.
Ну и добавь отсустствующие месяцы.
Код:
Dim FSO
Dim TheFolder, TheFiles, AFile
Dim objFolder
Dim sep, nov, dec
on error resume next'иначе выкидывает ошибки после перемещения
Set FSO = CreateObject("Scripting.FileSystemObject")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='c:\Temp\IN'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
For Each objFolder in colSubfolders
if mid(objFolder.Name, 12, 2) = "09" Then sep = objFolder.Name ' : msgbox "OK: " & objFolder.Name :msgbox "sep: " & sep
if mid(objFolder.Name, 12, 2) = "11" Then nov = objFolder.Name
if mid(objFolder.Name, 12, 2) = "12" Then dec = objFolder.Name
REM Wscript.Echo "Name: " & objFolder.Name
Next
Set TheFolder = FSO.GetFolder("C:\Temp\IN\") 'Каталог, где смотреть
Set TheFiles = TheFolder.Files
For Each AFile In TheFiles
'msgbox FSO.GetFile(AFile.Path).DateLastModified
if sep <> "" then : If mid((FSO.GetFile(AFile.Path).DateLastModified),4, 2) = "09" Then FSO.MoveFile AFile.Path , sep & "\"
if nov <> "" then : If mid((FSO.GetFile(AFile.Path).DateLastModified),4, 2) = "11" Then FSO.MoveFile AFile.Path , nov & "\"
if dec <> "" then : If mid((FSO.GetFile(AFile.Path).DateLastModified),4, 2) = "12" Then FSO.MoveFile AFile.Path , dec & "\"
next
|
|
