1 Тема от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Тема: VBScript: BackUp файлов с рекурсивным перебором каталогов

Пример скрипта, который делает BackUp файлов с рекурсивным перебором каталогов. Копируем файлы из одного определённого каталога в другой. Копируем только файлы с датой создания, меньшей указанной. В каталоге скрипта создаётся лог-файл CopyLog.log.

InitialFolder = "C:\Job" ' каталог, откуда копируем
TargetFolder = "C:\Temp\Temp" ' каталог, куда копируем
ControlDate = CDate("01.08.2006") ' контрольная дата (копируем файлы с датой создания раньше этой)
'====================================================================
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()

CopyFiles InitialFolder
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close

' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    On Error Resume Next
    Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
    For Each objFolderItem In objFolderItems
        If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles objFolderItem.Path
        Else
            Set objFile = objFSO.GetFile(objFolderItem.Path)
            If objFile.DateCreated < ControlDate Then
                CopyFile objFolderItem.Path
            End If
        End If
    Next
End Sub

' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    TargetPath = TargetFolder & SubPath
    FolderPath = objFSO.GetParentFolderName(TargetPath)
    If Not objFSO.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут 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
End Sub

' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    On Error Resume Next
    ParentFolder = objFSO.GetParentFolderName(FolderPath)
    If Not objFSO.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    objFSO.CreateFolder FolderPath
End Sub
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

2 Ответ от The gray Cardinal

  • The gray Cardinal
  • Разработчик
  • Неактивен

Re: VBScript: BackUp файлов с рекурсивным перебором каталогов

Поскольку постоянно спрашивают, привожу пример скрипта, который делает простейший BackUp файлов без подкаталогов и без условий. Копируем только файлы из одного определённого каталога в другой. В каталоге скрипта создаётся лог-файл CopyLog.log.

InitialFolder = "C:\Job\AutoHotkey" ' каталог, откуда копируем
TargetFolder = "C:\Temp\Temp" ' каталог, куда копируем
'====================================================================
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()

'Если каталог назначения не существует, создадим его
If Not objFSO.FolderExists(TargetFolder) Then
    objFSO.CreateFolder TargetFolder
    If Err.Number Then Breakdown
End If
For Each objFile In objFSO.GetFolder(InitialFolder).Files
    TargetPath = TargetFolder & "\" & objFile.Name
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If objFSO.FileExists(TargetPath) Then
        Set objTargetFile = objFSO.GetFile(TargetPath)
        If objTargetFile.Attributes And 1 Then
            objTargetFile.Attributes = objTargetFile.Attributes - 1
            If Err.Number Then Breakdown
        End If
    End If
    objFSO.CopyFile objFile.Path, TargetPath, True
    If Err.Number Then Breakdown
    LogStream.WriteLine TargetPath
Next
If Err.Number Then Breakdown

LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close

' процедура аварийного выхода
Sub Breakdown()
    LogStream.WriteLine Err.Number & ":" & Err.Description
    LogStream.WriteLine "Аварийный выход: " & Now()
    LogStream.Close
    WScript.Quit
End Sub
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.