Vbscript Переместить файлы и скопировать структуру папок 90 дней или более, чем сейчас - PullRequest
Новая
       28

Vbscript Переместить файлы и скопировать структуру папок 90 дней или более, чем сейчас

1 голос
/ 21 февраля 2012

Я просматриваю папки в общей папке, копирую всю структуру, если папки или подпапки содержат файлы старше 90 дней.(перемещать файлы старше указанной структуры дней - копировать, если в папках содержатся указанные устаревшие файлы)

У меня есть сценарий, который я нашел в Интернете, я изменил его, чтобы действительно правильно использовать функцию DateAdd, и кажется, что файлы перемещаются поверхструктура не копируется.

Пример.

2 Совместное использование местоположений, содержащих файлы (это не точная структура, а пример) 

Source
1. \\Share1\folder
2.         \Folder\Files
3.                \Folder\Files
4.         \Folder

1. \\Share2\folder
2.         \Folder\Files
3.                \Folder\Files
4.         \Folder
Destination
1. \\Share2\folder
2.         \Folder\Files
3.                \Folder\Files
4.         \Folder

1. \\Share2\folder
2.         \Folder\Files
3.                \Folder\Files
4.         \Folder

Dim objFSO, ofolder, objStream

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objNet = CreateObject("WScript.NetWork")
Set FSO = CreateObject("Scripting.FileSystemObject")
set outfile = fso.createtextfile("Move-Result.txt",true)
SPath = "Y:\test"
Sdest = "Y:\Archive\"

ShowSubfolders FSO.GetFolder(spath)

Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
CheckFolder(subfolder)
ShowSubFolders Subfolder
Next
End Sub

'CheckFolder(objFSO.getFolder(SPath))

Sub CheckFolder(objCurrentFolder)
Dim strTempL, strTempR, strSearchL, strSearchR, objNewFolder, objFile
Const OverwriteExisting = TRUE
currDate = Date
dtmDate = DateAdd("d",-90,Now)
strTargetDate = ConvDate(dtmDate)
For Each objFile In objCurrentFolder.Files
FileName = objFile
'WScript.Echo FileName
'strDate = ConvDate(objFile.DateCreated)
strDate = ConvDate(objFile.DateLastModified)
If strDate < strTargetDate Then
objFSO.MoveFile FileName, Sdest
outfile.writeline Filename
End If
Next
End Sub

Function ConvDate (sDate) 'Converts MM/DD/YYYY HH:MM:SS to string YYYYMMDD
strModifyDay = day(sDate)
If len(strModifyDay) < 2 Then
strModifyDay = "0" & strModifyDay
End If
strModifyMonth = Month(sDate)
If len(strModifyMonth) < 2 Then
strModifyMonth = "0" & strModifyMonth
End If
strModifyYear = Year(sDate)
ConvDate = strModifyYear & strModifyMonth & strModifyDay
End Function

1 Ответ

0 голосов
/ 21 февраля 2012

Я недавно написал класс для обработки синхронизации файлов, который вы можете адаптировать к вашим потребностям.

Здесь приведена ссылка на документацию для Первичного класса И Класс отдельных файловых объектов

В нижней части страницы есть кнопка для просмотра / сохранения исходного кода с надписью «Active Development Branch»

Включение этого класса в ваш проекттогда вы могли бы достичь своей цели следующим образом. 

Dim oSyncAgent, sUpdateSource, sUpdateTarget, dMinAge, aStagedAFiles, iIterator
Set oSyncAgent = New SynchronizationAgent

sUpdateSource = "Y:\test"
sUpdateTarget = "Y:\Archive"
dMinAge = DateAdd("d",-90,Now)

'This will only proceed if the SetLocations() function is successful
If oSyncAgent.SetLocations(sUpdateSource,sUpdateTarget) Then

  'Get a working copy of the files staged for sync from location A to B
  aStagedAFiles = oSyncAgent.LocationAStaged

  'Loop over files staged for synchronization and cancel any that were created in the last 90 days
  For iIterator = 0 To UBound(aStagedAFiles)
    If aStagedAFiles(iIterator).DateCreated >= dMinAge Then
      aStagedAFiles(iIterator).Process = False
    End If
  Next 'SyncFile

  'Set the modified list of files to be synced back to the agent
  oSyncAgent.LocationAStaged = aStagedAFiles

  'Execute the sync ignoring the files we set above
  oSyncAgent.AbSync(False) 'Don't mirror location A

End If

Set oSyncAgent = Nothing
...