Dim objFSO, objFolder, objShell, strDirectory
strDirectory = "n:\MY_SETTINGS\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
End If
'***********************************************
' Создание объектов оболочки и файловой системы
Set oShell = CreateObject("wscript.shell")
Set oFSO = CreateObject("Scripting.Filesystemobject")
Set WSNetwork = CreateObject("WScript.Network")
LogFolder = "C:\LOG\" ' место расположения лог-файла
StartFolder = "n:\MY_SETTINGS\" ' откуда копируем
aEndFolder = array("g:\My Flash 32 system\WPI\Install\MY_SETTINGS\", "g:\MY_SETTINGS\") ' куда копируем
'***********************************************
' обнуление и описание счетчиков, используемых в скрипте
num_EndFolder = 0 '- общее число папок, места назначения для копируемых данных
num_EndFolder_0 = 0 '- не доступное кол-во папок из num_EndFolder
num_files = 0 '- общее число обработанных файлов
num_files_copy = 0 '- из них скопировано с заменой на новую версию
err_files_copy = 0 '- из них не скопировано в результате ошибки при работе с num_files_copy
num_files_new = 0 '- из них скопировано новых файлов
err_files_new = 0 '- из них не скопировано в результате ошибки при работе с num_files_new
num_SubFolder = 0 '- обработано папок и подпапок
num_SubFolder_copy = 0 '- из них скопировано новых папок и подпапок
err_SubFolder = 0 '- из них не скопировано в результате ошибки при работе с num_SubFolder
'***********************************************
' Создание лог-файла
' Задаем имя лога
sLogName = "CheckOps"
' Заменяем в имени все знаки на подчеркивания
sLogName = Replace(sLogName, ".", ".")
sLogName = Replace(sLogName, ":", ".")
sLogName = LogFolder & sLogName
' Создаем файл
Set oLogFile = oFSO.CreateTextFile(sLogName & ".log",true)
oLogFile.WriteLine "========== Script Information ==========" & vbCrLf
oLogFile.WriteLine "script name: Fail_Copying"
oLogFile.WriteLine "version: 1.0"
oLogFile.WriteLine "date: 10.08.12"
oLogFile.WriteLine "autor: MasterLin"
oLogFile.WriteLine "site: http://www.masterlin.ru" & vbCrLf
oLogFile.WriteLine "========== Запуск скрипта ==========" & vbCrLf
'***********************************************
Set oEndFolder = CreateObject("Scripting.FileSystemObject")
' Цикл для перебора папок "куда копируем"
For i=0 to UBound (aEndFolder)
' Счетчик кол-ва папок для копируемых данных
num_EndFolder=num_EndFolder+1
' Проверяем доступность папки, в которую хотим произвести копирование
If oEndFolder.FolderExists ( aEndFolder(i) ) Then
' Записываем результат в лог
oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " доступна для работы" & vbCrLf
CopyFolder StartFolder,aEndFolder(i)
' Счетчик доступных для копирования папок
' удолил :)
else
' Записываем результат в лог
oLogFile.Writeline
oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена." & vbCrLf
' Дублируем сообщение, выводом предупреждения на экран
WScript.Echo "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена."
' Счетчик недоступных для копирования папок
num_EndFolder_0=num_EndFolder_0+1
End if
Next
oLogFile.WriteLine "========== Отчет о копировании ==========" & vbCrLf
oLogFile.WriteLine "Было задано " & num_EndFolder & " папок, для копирования в них данных."
oLogFile.WriteLine "Часть папок оказалась не доступна - " & num_EndFolder_0 & " шт. (см.логи выше)"
oLogFile.WriteLine "Скриптом было обработано - " & num_files & " файлов."
oLogFile.WriteLine "Из них скопировано с заменой - " & num_files_copy & " шт., не скопировано в результате ошибки - " & err_files_copy & " шт."
oLogFile.WriteLine "Из них скопировано новых файлов - " & num_files_new & " шт., не скопировано в результате ошибки - " & err_files_new & " шт."
oLogFile.WriteLine "Скриптом было обработано - " & num_SubFolder & " подпапок."
oLogFile.WriteLine "Из них скопировано новых подпапок - " & num_SubFolder_copy & " шт., не скопировано в результате ошибки - " & err_SubFolder & " шт."
oLogFile.WriteLine
Sub CopyFolder(sCopyFolder,sEndCopyFolder)
' Создание объекта Folder
Set oFolder = oFSO.GetFolder(sCopyFolder)
Set oEndCopyFolder = oFSO.GetFolder(sEndCopyFolder)
' Получение коллекции файлов
Set colFiles = oFolder.Files
' Обработка каждого файла из коллекции
For each oFile in colFiles
oLogFile.Writeline "Дата создания копируемого файла:"
oLogFile.Writeline oFile & vbTab & oFile.DateCreated
' Счетчик числа проверяемых файлов
num_files=num_files+1
' Проверяем существует уже такой файл в папке, если его нет, то копируем.
' Если есть, то проверяем его актуальность и заменяем более новым, если он устарел.
If oFSO.FileExists(oFSO.BuildPath(oEndCopyFolder, oFile.Name)) Then
' Записываем результат в лог
oLogFile.Writeline "Такой файл уже существует в папке " & oEndCopyFolder
' Проверяем насколько это свежая копия файла, для этого сравниваем даты создания двух файлов
oLogFile.Writeline "Проверяем актуальность копии:"
' Выгружаем полный путь к проверяемому файлу
sFileEnd = oFSO.BuildPath(oEndCopyFolder, oFile.Name)
' Создаем объект File, для работы с этим файлом
Set oFileEnd = oFSO.GetFile(sFileEnd)
' Сравниваем даты изменения файлов
If oFileEnd.DateLastModified < oFile.DateLastModified Then
' Проверяемый файл оказался устаревшим, поэтому заменяем его более новым
oLogFile.Writeline "Копия файла устарела, заменяем его новым. **********" & vbCrLf
oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
' Проверка на наличие ошибок
if err.Number <> 0 then
' Запись сообщения об ошибке в лог
oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
' Очистка ошибки
Err.Clear
' Счетчик ошибок при замене файлов
err_files_copy=err_files_copy+1
else
' Счетчик файлов, которые были заменены на новые
num_files_copy=num_files_copy+1
End if
else
' В этом случае копия прошла проверку, просто продолжаем работу скрипта далее
oLogFile.Writeline "Копия актуальна. Продолжаем работу." & vbCrLf
End if
else
' Записываем результат в лог
oLogFile.Writeline "Этот файл отсутствует в папке " & oEndCopyFolder & " Давайка его скопируем." & vbCrLf
oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
' Проверка на наличие ошибок
if err.Number <> 0 then
' Запись сообщения об ошибке в лог
oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
' Очистка ошибки
Err.Clear
' Счетчик ошибок при копировании новых файлов
err_files_new=err_files_copy+1
else
' Счетчик новых скопированных файлов
num_files_new=num_files_copy+1
End if
End if
Next
' Проверяем все папки и подпапки
oLogFile.Writeline "Обрабатываем и копируем все подпапки из папки " & oEndCopyFolder & vbCrLf
' Получение коллекции подпапок
Set colSubFolders = oFolder.SubFolders
' Обработка каждой подпапки
For Each oSubFolder In colSubFolders
oLogFile.Writeline "Проверяем подпапку " & oSubFolder
' Счетчик обработанных папок и подпапок
num_SubFolder=num_SubFolder+1
' Проверяем существует уже такая подпапка в папке, если ее нет, то копируем.
' Если есть, то переходим к проверке файлов в подпапке.
If oFSO.FolderExists(oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path))) Then
' Записываем результат в лог
oLogFile.Writeline "Такая подпапка уже существует в папке " & oEndCopyFolder
oLogFile.Writeline "Проверяем все файлы в этой подпапке: "
' Выгружаем полный путь к проверяемоой подпапке
sSubFolderEnd = oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path)) & "\"
' Производим рекурсивный вызов процедуры копирования файлов - программа вызывает сама себя
CopyFolder oSubFolder, sSubFolderEnd
' oLogFile.Writeline
else
' Записываем результат в лог
oLogFile.Writeline "Эта подпапка отсутствует в папке " & oEndCopyFolder & " Давайка ее скопируем." & vbCrLf
oFSO.CopyFolder oSubFolder, sEndCopyFolder, True
' Проверка на наличие ошибок
if err.Number <> 0 then
' Запись сообщения об ошибке в лог
oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
' Очистка ошибки
Err.Clear
' Счетчик ошибок при копировании новых папок и подпапок
err_SubFolder=err_SubFolder+1
else
' Счетчик новых скопированных папок и подпапок
num_SubFolder_copy=num_SubFolder_copy+1
End if
End if
Next
End Sub
