Перемещение данных в подпапки с указанием даты
Добрый день!
Имеются две папки: C:\Source и C:\Dest. Необходимо переместить содержимое папки C:\Source в папку C:\Dest\YYYYMMDD, где YYYYMMDD - текущая дата. Скрипт будет запускаться раз в сутки и переносить наработанные данные в папку с указанием дня работ. Один нюанс, поскольку скрипт будет запускаться в 00:00:00, возможно, необходимо, что бы дата была вчерашней.
Заранее Благодарю!
|
PAlkovnic, у Вас что — семинар?
Цитата:
Цитата PAlkovnic
Имеются две папки: C:\So urce »
|
Поправили по сравнению с прошлым вопросом, да ;)?
Код:
Option Explicit
Dim strSourceFolder
Dim strDestFolder
Dim strDestPath
strSourceFolder = "C:\Source"
strDestFolder = "C:\Dest"
With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFolder) Then
If .FolderExists(strDestFolder) Then
strDestPath = .BuildPath(strDestFolder, GetPrevDateToString())
CreateFolderEx strDestPath
If .GetFolder(strSourceFolder).SubFolders.Count > 0 Then
.MoveFolder .BuildPath(strSourceFolder, "*.*"), strDestPath
End If
If .GetFolder(strSourceFolder).Files.Count > 0 Then
.MoveFile .BuildPath(strSourceFolder, "*.*"), strDestPath
End If
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
End If
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
End If
End With
WScript.Quit 0
'=============================================================================
'=============================================================================
Function GetPrevDateToString()
Dim dtDate
dtDate = DateAdd("d", -1, Date())
GetPrevDateToString = Right("0000" & CStr(Year(dtDate)), 4) & Right("00" & CStr(Month(dtDate)), 2) & Right("00" & CStr(Day(dtDate)), 2)
End Function
'=============================================================================
'=============================================================================
Sub CreateFolderEx(strPath)
With WScript.CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(strPath) Then
CreateFolderEx .GetParentFolderName(strPath)
.CreateFolder strPath
End If
End With
End Sub
'=============================================================================
|
Нет :( , сказали сделать, спросил сроки, "позавчера" был ответ.
И именно по этому опечатался в предыдущей теме, спешил.
За скрипт огромная благодарность! Выручили! |
Цитата:
Цитата PAlkovnic
спросил сроки, "позавчера" был ответ. »
|
Ну, это как обычно ;). |
Время: 19:49.
© OSzone.net 2001-
