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 |
|
