Hugo121
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору Я свой код подправил, обрабатывает папку с скриптом: Код: 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") MyPath = left (WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName))) MyPathShort = Left(MyPath, Len(MyPath)-1) Set colSubfolders = objWMIService.ExecQuery _ ("Associators of {Win32_Directory.Name='" & MyPathShort & "'} " _ & "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 "september: " & sep if mid(objFolder.Name, 12, 2) = "11" Then nov = objFolder.Name if mid(objFolder.Name, 12, 2) = "12" Then dec = objFolder.Name 'msgbox "objFolder Name: " & objFolder.Name ' Next Set TheFolder = FSO.GetFolder(MyPath) 'Каталог, где смотреть Set TheFiles = TheFolder.Files For Each AFile In TheFiles If UCase(FSO.GetExtensionName(AFile.Path)) = "MSG" then '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 & "\" end if next | Добавлено: vlth - погонял чуток Ваш код - вначале не хотел вообще работать, теперь работает, но только с двузначными месяцами. Мучил Format, не получается пока... Код: Dim fso, oFile, oFolder, oSubFolder, strNMonth Const cstrPath = "C:\temp\IN" Set fso = wsh.CreateObject("Scripting.FileSystemObject") Set oFolder = fso.GetFolder(cstrPath) For Each oFile In oFolder.Files If UCase(FSO.GetExtensionName(oFile.Path)) = "MSG" Then strNMonth = CStr(Month(oFile.DateLastModified)) msgbox strNMonth 'вот здесь надо добиться 2-х знаков For Each oSubFolder In oFolder.SubFolders If Left(oSubFolder.Name, 2) = strNMonth Then _ oFile.Move oSubFolder.Path & "\" & oFile.Name Next End If Next | Ну и надо прикрутить к текущей папке. Вообще красиво и компактно может получиться, возьму на вооружение, когда сделаем. Так, 2 цифры сделал грубо ломом if len(strNMonth) = 1 then strNMonth = "0" & strNMonth работает Осталась текущая папка... | Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 16:10 08-12-2009 | Исправлено: Hugo121, 16:52 08-12-2009 |
|