[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