Нужен vbs скрипт
Формулировка задачи:
Помогите со скриптом, который из одной папки в другую копирует все файлы, кроме последнего по времени и дате создания... например, если в студии работает прога по звукозаписи, а последний фалй в папке еще в процессе записи, то именно этот файл копировать не нужно, а все остальные копруются...этот файл скопируется позже...
пользуюсь вот этим скриптом:
все файлы из одной папки копируются куда надо, за исключением файла, который в процессе записи...
и выдается ошибка:
строка 142
символ 4
Ошибка: Разрешение отклонено
Код: 800А0046
как исправить? помогите плиз, люди добрые!!!
пользуюсь вот этим скриптом:
Листинг программы
- ' Создание объектов оболочки и файловой системы
- Set oShell = CreateObject("wscript.shell")
- Set oFSO = CreateObject("Scripting.Filesystemobject")
- Set WSNetwork = CreateObject("WScript.Network")
- LogFolder = "C:\авб\"
- StartFolder = "c:\1\"
- aEndFolder = array("c:\kopii\")
- '***********************************************
- ' обнуление и описание счетчиков, используемых в скрипте
- 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 = "LogTemp_" & Date & "_" & Time
- ' Заменяем в имени все знаки на подчеркивания
- 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
- 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
- ' если у файла назначения есть атрибут ReadOnly, снимаем его
- If objFSO.FileExists(TargetPath) Then
- Set objFile = objFSO.GetFile(TargetPath)
- If objFile.Attributes And 1 Then
- objFile.Attributes = objFile.Attributes - 1
- End If
- End If
- objFSO.CopyFile FilePath, TargetPath, True
- If Err.Number <> 0 Then
- LogStream.WriteLine
- LogStream.WriteLine FilePath
- LogStream.WriteLine Err.Description
- LogStream.WriteLine
- Err.Clear
- Else
- LogStream.WriteLine TargetPath
- End If
- ' Проверка на наличие ошибок
- 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
все файлы из одной папки копируются куда надо, за исключением файла, который в процессе записи...
и выдается ошибка:
строка 142
символ 4
Ошибка: Разрешение отклонено
Код: 800А0046
как исправить? помогите плиз, люди добрые!!!
Решение задачи: «Нужен vbs скрипт»
textual
Листинг программы
- On Error Resume Next
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д