[deepred]

Перенос файлов в уже готовые папки в зависимости от даты создания.

Код:

Option Explicit
Dim FSO, oFile, oFolder, oFolderBox, oSubFolder, strNMonth    
Dim ScPath, ScPathBox      
ScPath = left(WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName))-1)     
ScPathBox = ScPath & "\box"      
Set FSO = CreateObject("Scripting.FileSystemObject")    
Set oFolder = FSO.GetFolder(ScPath)    
Set oFolderBox = FSO.GetFolder(ScPathBox)       
For Each oFile In oFolder.Files        
If UCase(FSO.GetExtensionName(oFile.Path)) = "exe" Then           
strNMonth = Right("0" & CStr(Month(oFile.DateLastModified)),2)           
For Each oSubFolder In oFolderBox.SubFolders                
If Left(oSubFolder.Name, 2) = strNMonth Then _                    
oFile.Move oSubFolder.Path & "\" & oFile.Name            
Next        
End If    
Next

Хотя существует множество программ аналогичного назначения, но с большим набором функций...


Второй вариант (уже готовый и давно используемый) с созданием папок..., но в данном случае файлы имеют имя ops_project_дд.мм.гг.dwg

Код:

Option Explicit 
   Dim objFSO, objFile

  Dim strPath2SourceFolder, strPath2RootDestFolder, strPath2DestFolder
  Dim intPrefix, strMonth  
  Dim intErrLevel    
 
  strPath2SourceFolder   = "C:\dir1\dir2\ops-sourse"
  strPath2RootDestFolder = "C:\dir1\dir2\ops-result"    
  intErrLevel = 0  
  intPrefix   = Len("ops_project_")    

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")      

If objFSO.FolderExists(strPath2SourceFolder) Then      
   If objFSO.FolderExists(strPath2RootDestFolder) Then         
    For Each objFile In objFSO.GetFolder(strPath2SourceFolder).Files             
     If UCase(Left(objFile.Name, intPrefix)) = UCase("ops_project_") And _            
      UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("dwg") Then   

      strMonth = Mid(objFSO.GetBaseName(objFile.Name), intPrefix + 3 + 1, 2) 
      strPath2DestFolder = objFSO.BuildPath(strPath2RootDestFolder, strMonth)

                      If Not objFSO.FolderExists(strPath2DestFolder) Then                  
                        objFSO.CreateFolder strPath2DestFolder                 
                      End If                                   
                         objFile.Move strPath2DestFolder & "\"          
                  End If          
               Next      
             Else          

         WScript.Echo "Destination folder [" & strPath2RootDestFolder & "] is not exists." 
        intErrLevel = 2      
        End If  

Else 
     WScript.Echo "Source folder [" & strPath2SourceFolder & "] is not exists."     
     intErrLevel = 1  
    End If 
   Set objFSO = Nothing 
   WScript.Quit intErrLevel

[osp2008]

Да но так я отсортирую и текущий месяц

[osp2008]

и как быть если месяцев несколько?

[deepred]

отсортируется каждый месяц...., в чем причина не желания сортировки на текущий месяц? В следующем месяце все равно надо же сортировать?

Последний вариант!! Все требования учтены!!!

Код:

Option Explicit 
Dim objFSO, objFile
Dim strPath2SourceFolder, strPath2RootDestFolder, strPath2DestFolder
Dim intPrefix, strMonth  
Dim intErrLevel    
strPath2SourceFolder   = "F:\exe\"
strPath2RootDestFolder = "F:\exe\outfolder\"    
intErrLevel = 0  
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")      
If objFSO.FolderExists(strPath2SourceFolder) Then
If objFSO.FolderExists(strPath2RootDestFolder) Then         
For Each objFile In objFSO.GetFolder(strPath2SourceFolder).Files
if UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("exe") And _
DateDiff("M", objFile.DateLastModified, Now) <> 0 Then   
strMonth = mid(objFSO.GetBaseName(objfile.DateLastModified),+4) & "." & Left(objFSO.GetExtensionName(objfile.DateLastModified),4)
strPath2DestFolder = objFSO.BuildPath(strPath2RootDestFolder, strMonth)
If Not objFSO.FolderExists(strPath2DestFolder) Then
objFSO.CreateFolder strPath2DestFolder          
End If                                   
objFile.Move strPath2DestFolder & "\"          
End If          
Next      
Else          
WScript.Echo "Destination folder [" & strPath2RootDestFolder & "] is not exists." 
intErrLevel = 2      
End If
Else
WScript.Echo "Source folder [" & strPath2SourceFolder & "] is not exists."     
intErrLevel = 1
End If 
Set objFSO = Nothing 
WScript.Quit intErrLevel

Два момента:

1. Отработку я сделал для файлов имеющий "ext" - exe, т.к. делал под себя (чтобы не просто так), если это не нужно, то достаточно просто исключить строку с определением Ucase ("" UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("exe") "");


2. В критерий даты можно выставить и "DateLastaccess" и "DateCreated" (не только "DateLastModified").

И почему не *.bat? было бы проще....

Код:

@Echo Off&&Chcp 866    

rem Указываем dir-рию для обработки   
Set $SCR=F:\exe    

rem Получаем имена файлов по критерию (т.е. не имеющих изменений в тек. месяце)  
for /F "tokens=2-3,6* Delims=. " %%a In ^
('DIR /a-d /tw %$SCR% ^| Find /i "%date:~-4%"') do (
                                          set ch=%%a.%%b
                                          set cell=%%c.%%d
                                          call :sorted_move)
goto :eof      

rem Создаем папку с имененем, содержащим дату изменения и перемещаем файлы
:sorted_move    

if NOT "%ch%"=="%date:~3%" ((if not exist "%$SCR%\sorted\dir_%ch%" ^
                              md %$SCR%\sorted\dir_%ch%
                              move /y %$SCR%\%cell% %$SCR%\sorted\dir_%ch%\%cell%
                              )) else goto :eof

[osp2008]

Спасибо что помогли