Серый форум — VBS: JPG не протоколируется

Re: VBS: JPG не протоколируется

null@example.com (Flasher) — Mon, 29 Jun 2015 14:08:05 +0000

1-2) Не сталкивался, вроде должно писать без проблем.
2) WScript.Sleep 60000 - зачем? Выкинуть и забыть.
4) Конечно. Разные даты и по-разному представлены. Для mpg строка dd = Split(Replace(dd, Left(dd, 1), ""))(0) лишняя. И лучше использовать именно мой метод, т.к. нулей может и не оказаться с учётом других региональных настроек.

Re: VBS: JPG не протоколируется

null@example.com (wildwolf007) — Mon, 29 Jun 2015 13:46:43 +0000

Очень странно получается дописал для Jpg свою обработку по дате, а для Mpg свою обработку и все получилось и стало протоколироваться

                Dim dd
                Set File = FSO.GetFile(Fl)
                FileName = File.Name
                FileParentFolder = File.ParentFolder
                NextCheck = 1
                IF LCase(FSO.GetExtensionName(File)) = LCase("jpg") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 12)
                    NextCheck = 0
                    
                    If NextCheck = 0 Then
                        If dd = "" Then
                            D = "Нет_даты"
                        Else
                            
'                            DMY = Split(dd,".")
'                            YYYY = Split(DMY(2)," ")
'                            D = YYYY(0) & "." &DMY(1) & "." & DMY(0)  
                            
                            
                            dd = Split(Replace(dd, Left(dd, 1), ""))(0)
                            D = Day(dd)   : If Len(D) = 1 Then D = "0" & D
                            M = Month(dd) : If Len(M) = 1 Then M = "0" & M
                            D = Year(dd) & "." & M & "." & D
                            
                        End If
                    Else
                        call WhoTakeFile(File.Path, "Файл не определен","Перенос не осуществлен")
                        'D = "Формат_файла_не_определен"
                        NextCheck = 1
                    End IF
                    
                End IF
                
                IF LCase(FSO.GetExtensionName(File)) = LCase("mp4") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 3)
                    NextCheck = 0
                    
                    If NextCheck = 0 Then
                        If dd = "" Then
                            D = "Нет_даты"
                        Else
                            
                            DMY = Split(dd,".")
                            YYYY = Split(DMY(2)," ")
                            D = YYYY(0) & "." &DMY(1) & "." & DMY(0)  
                            
                            
'                            dd = Split(Replace(dd, Left(dd, 1), ""))(0)
'                            D = Day(dd)   : If Len(D) = 1 Then D = "0" & D
'                            M = Month(dd) : If Len(M) = 1 Then M = "0" & M
'                            D = Year(dd) & "." & M & "." & D
                            
                        End If
                    Else
                        call WhoTakeFile(File.Path, "Файл не определен","Перенос не осуществлен")
                        'D = "Формат_файла_не_определен"
                        NextCheck = 1
                    End IF 
                    
                End IF

Итоговая версия:

Dim FSO, FldN, FldN1, Fl, D, FlN, FlN1, i

Dim FileMassiv()

Dim Folder, File

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")


Do
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Выберите каталог размещения файлов:", 0) 
    'Если пользователь не выбрал папку, завершаем приложение &H0001 + &H4000
    If objFolder Is Nothing Then Exit Do
    'Получаем путь к выбранной папке
    FldN = objFolder.Self.Path
    FoundColon = InStr(1,FldN,":",vbTextCompare)
    If FoundColon = 1 Then
        MsgBox "Вы выбрали некорректную папку размещения файлов попробуйте еще раз!"
    End if
Loop while(FoundColon = 1)

If objFolder Is Nothing Then
    MsgBox "Не выбран каталог размещения файлов"
Else

    If Not FSO.FolderExists(FldN) Then
        MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
        WScript.Quit
    End If
    
    Do
        Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Выберите каталог куда будут перемещаться файлы:", 0) 
        'Если пользователь не выбрал папку, завершаем приложение &H0001 + &H4000
        If objFolder Is Nothing Then Exit Do
        'Получаем путь к выбранной папке
        FldN1 = objFolder.Self.Path
        FoundColon = InStr(1,FldN1,":",vbTextCompare)
        If FoundColon = 1 Then
            MsgBox "Вы выбрали некорректную папку размещения файлов попробуйте еще раз!"
        End if
    Loop while(FoundColon = 1)
    
    If objFolder Is Nothing Then
        MsgBox "Не выбран каталог размещения файлов"
    Else
        
        If Not FSO.FolderExists(FldN1) Then
            MsgBox "Папка """ & FldN1 & """ не существует. ", vbExclamation, "Ошибка"
            WScript.Quit
        End If
        
        Dim NextCheck
        
        NextCheck = 0
        
        Erase FileMassiv
        reDim preserve FileMassiv(-1)
        'Запуск рекурсии по каталогу для нахождения файлов и помещения в массив FileMassiv() с полным путем нахождения
        Call CheckFolderInFolder (FldN &"\")
        'MsgBox Ubound(FileMassiv)
        If Ubound(FileMassiv,1) = -1 Then
            
            ''WScript.Echo "Файлов в данном каталоге нет" 
            NextCheck = 1
            
        End IF
        
        If NextCheck = 0 Then
            
            For Each Fl In FileMassiv
                Dim dd
                Set File = FSO.GetFile(Fl)
                FileName = File.Name
                FileParentFolder = File.ParentFolder
                NextCheck = 1
                IF LCase(FSO.GetExtensionName(File)) = LCase("jpg") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 12)
                    NextCheck = 0
                    
                    If NextCheck = 0 Then
                        If dd = "" Then
                            D = "Нет_даты"
                        Else
                            
'                            DMY = Split(dd,".")
'                            YYYY = Split(DMY(2)," ")
'                            D = YYYY(0) & "." &DMY(1) & "." & DMY(0)  
                            
                            
                            dd = Split(Replace(dd, Left(dd, 1), ""))(0)
                            D = Day(dd)   : If Len(D) = 1 Then D = "0" & D
                            M = Month(dd) : If Len(M) = 1 Then M = "0" & M
                            D = Year(dd) & "." & M & "." & D
                            
                        End If
                    Else
                        call WhoTakeFile(File.Path, "Файл не определен","Перенос не осуществлен")
                        'D = "Формат_файла_не_определен"
                        NextCheck = 1
                    End IF
                    
                End IF
                
                IF LCase(FSO.GetExtensionName(File)) = LCase("mp4") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 3)
                    NextCheck = 0
                    
                    If NextCheck = 0 Then
                        If dd = "" Then
                            D = "Нет_даты"
                        Else
                            
                            DMY = Split(dd,".")
                            YYYY = Split(DMY(2)," ")
                            D = YYYY(0) & "." &DMY(1) & "." & DMY(0)  
                            
                            
'                            dd = Split(Replace(dd, Left(dd, 1), ""))(0)
'                            D = Day(dd)   : If Len(D) = 1 Then D = "0" & D
'                            M = Month(dd) : If Len(M) = 1 Then M = "0" & M
'                            D = Year(dd) & "." & M & "." & D
                            
                        End If
                    Else
                        call WhoTakeFile(File.Path, "Файл не определен","Перенос не осуществлен")
                        'D = "Формат_файла_не_определен"
                        NextCheck = 1
                    End IF 
                    
                End IF
                
                
                
                
                If NextCheck = 0 Then
                    
                    FlN = FldN1 &"\" &D &"\" &FileName
                    FlN1 = FldN1 &"\" & D &"\" &FileName
                    
                    If Not FSO.FolderExists(FldN1 &"\" &D) Then 

                        Dim tt
                        tt = "Будет создана папка " &D &" и помещен файл " &File.Name &" " &D &" = " &File.DateLastModified
                        'Создание папок по запросу
                        'ExitFromName = MsgBox (tt, 36, "Прекратить создание папки?") 
                        
                        If ExitFromName = 6 Then 
                            Exit For
                        End If  
                        
                        FSO.CreateFolder (FldN1 &"\" &D)
                    End If
                    
                    
                    If FSO.FileExists(FlN) Then
                        rr = "Файл " & File.Name & " уже существует в папке " & D & ". " & vbCr & "Перезаписать?"
                        'ExitFromName1 = MsgBox (rr, 36, "Внимание") 
                        
                        ExitFromName1 = 7
                        
                        If ExitFromName1 = 6 Then
                            FSO.DeleteFile FlN, True
                            call WhoTakeFile(File.Path, "Файл Перезатерт",FlN1)
                            File.Move FlN
                        Else
                            
                            Set File3 = FSO.GetFile(FlN)
                            
                            call WhoTakeFile(File.Path, "Скопирована копия",FlN1)
                            
                            Set objShell = CreateObject("Shell.Application")
                            Set objFolder = objShell.NameSpace(FldN1 &"\" &D) 'место назначения
                            objFolder.CopyHere Fl,8
                            'WScript.Sleep 60000 'даём время на скачивание (минута)
                            File.Delete
                            
                        End If
                    Else
                    'MsgBox File.Path
                        call WhoTakeFile(File.Path, "Файл Перенесен",FlN1)
                        File.Move FlN
                    End If
                End IF
                
            Next
        End IF
        
    End IF
    
    MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
    WScript.Quit

End If


Function CheckFolderInFolder (P1)

    'P1 - передаваемый параметр пути где необходима рекурсия возвращаемый заполненный массив FileMassiv(i)
    
    RetCode = 0
    
    If Ubound(FileMassiv) = -1 Then
        i = -1
    End IF
    
    Dim File2,CollectionFolder,CollectionFile,Folder5
    
    Set Folder5 = FSO.GetFolder(P1)
    Set CollectionFolder = Folder5.SubFolders
    Set CollectionFile = Folder5.Files
    
    If CollectionFile.count > 0 Then
        For Each File2 In CollectionFile
            ' Сообщение о файле при переборе
            i = i + 1
            reDim preserve FileMassiv(i)
            FileMassiv(i) = File2.Path
            'MsgBox File2.Path &" = " &i
            'WScript.Echo File2.Path &" Размерность =" &i &" Размер массива = " &Ubound(FileMassiv)
        Next
    End If
    
    For Each SubFolder In CollectionFolder
        call CheckFolderInFolder (SubFolder)
    Next

End Function


Sub WhoTakeFile(P1,P2,P3)
    
    'P1 - обрабатываемый файл путь
    'P2 - наименование операции
    'P3 - директория для переноса
    
    Dim File1
    
    YearNow = Split(TakeFolderData,"_")
    
    Dim FileTakeUser
    Dim OpenFileBuzyCheck
    
    
    Set FileTakeUser = FSO.GetFile(P1)
    
    On Error Resume Next
    
    If Not FSO.FileExists(FldN1 &"\" &"Протокол"  &".txt") Then
        Set OpenFileBuzyCheck = FSO.OpenTextFile(FldN1 &"\" &"Протокол"  &".txt", 8, True)
        
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        OpenFileBuzyCheck.WriteLine "* Журнал обработки                                                                                                                                                                                                                                                                                                           *"
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        OpenFileBuzyCheck.WriteLine "* Обрабатываемый файл                                                                                       * Дата и время выполнения  * Производимая операция* Директория размещения                                                                      * дата создания       * Дата изменения      * Дата открытия       *"
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        
        Set File1 = FSO.GetFile(FldN1 &"\" &"Протокол"  &".txt")
    Else
        Set File1 = FSO.GetFile(FldN1 &"\" &"Протокол"  &".txt")
        Set OpenFileBuzyCheck = FSO.OpenTextFile(File1, 8, True)
    End If
    
    If Err.Number = 0 Then
    
        Dim P(7)
        P(0) = FileTakeUser.Path
        P(1) = P2
        P(2) = P3
        P(3) = FileTakeUser.DateCreated
        P(4) = FileTakeUser.DateLastModified
        P(5) = FileTakeUser.DateLastAccessed 
        P(6) = " - "
        P(7) = now
        
        Dim L(7)
        L(0) = 105
        L(1) = 20
        L(2) = 90
        L(3) = 18
        L(4) = 18
        L(5) = 18
        L(6) = 70
        L(7) = 24
        
        For a = 0 To 7 Step 1
            Do
                'WScript.Echo "=" &P(a) &"="
                If L(a) = "" Then
                    Exit Do
                End If
                If Len(P(a)) < L(a) Then
                    P(a) = P(a)  &" "
                End If
                'If Len(P(a)) < L(a) Then
                '    P(a) = " "  &P(a) 
                'End If
            Loop While (Len(P(a)) < L(a))
        Next
        OpenFileBuzyCheck.WriteLine "* " &P(0) &" * " &P(7) &" * " &P(1) &" * " &P(2) &" * " &P(3) &" * " &P(4) &" * " &P(5) &" *"
        OpenFileBuzyCheck.Close
    Else
        OpenFileBuzyCheck.Close
    End IF
    
    Err.Clear
    On Error Goto 0
    
End Sub

VBS: JPG не протоколируется

null@example.com (wildwolf007) — Mon, 29 Jun 2015 13:09:37 +0000

Ранее в другой теме создавал скрипт, который переносит из одной папки в другую и создает дату съемки для фотографий (что б наконец-таки разобрать свой фото архив). Сейчас дописал обработку для видео файлов, рекурсивный проход, меню выбора директорий и не могу понять почему не производится протоколирование для файлов JPG, а все остальное протоколируется без проблем. Пол дня просидел не могу понять ошибку.

Так же не понятные моменты, если кто сможет что-то подсказать по данным ошибкам буду очень благодарен:

1) Почему нельзя использовать напрямую File.Name и File.ParentFolder, которые получаю из

Set File = FSO.GetFile(Fl)

и приходится пересохранять в переменную.

                Set File = FSO.GetFile(Fl)
                FileName = File.Name
                FileParentFolder = File.ParentFolder
                NextCheck = 1
                IF LCase(FSO.GetExtensionName(File)) = LCase("jpg") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 12)
                    NextCheck = 0
                End IF
                
                IF LCase(FSO.GetExtensionName(File)) = LCase("mp4") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 3)
                    NextCheck = 0
                End IF

2) Почему здесь можно использовать переменную FL(в ней находится полный путь к файлу), но не получается использовать File.Path ведь я создаю объект Set File = FSO.GetFile(Fl)?

                            Set objShell = CreateObject("Shell.Application")
                            Set objFolder = objShell.NameSpace(FldN1 &"\" &D) 'место назначения
                            objFolder.CopyHere Fl,8
                            'WScript.Sleep 60000 'даём время на скачивание (минута)
                            File.Delete

И обязательно нужно использовать WScript.Sleep 60000 ???

3) При протоколировании, если убираю 3й передаваемый параметр, то Jpg так же начинает протоколироваться например
вместо

call WhoTakeFile(File.Path, "Скопирована копия",FlN1)

делаю например так

call WhoTakeFile(File.Path, "Скопирована копия","FlN1")

Предполагаю что-то не так с переменной D.

4) Предложенный вариант Flasher в 6-м посте темы VBS: Перенос фото в папку с датой съемки http://forum.script-coding.com/viewtopic.php?id=10731 не работает с файлами mpg говорит несоответствие типов:

    dd = Folder.GetDetailsOf(Folder.ParseName(Name1), 12)
    dd = Split(Replace(dd, Left(dd, 1), ""))(0)
    D = Day(dd)   : If Len(D) = 1 Then D = "0" & D
    M = Month(dd) : If Len(M) = 1 Then M = "0" & M
    D = Year(dd) & "-" & M & "-" & D

Пришлось использовать:

                        DMY = Split(dd,".")
                        YYYY = Split(DMY(2)," ")
                        D = DMY(0) & "." & DMY(1) & "." & YYYY(0)

Предполагаю что-то не так с переменной D.

Полный код ниже:

Dim FSO, FldN, FldN1, Fl, D, FlN, FlN1, i

Dim FileMassiv()

Dim Folder, File

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")


Do
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Выберите каталог размещения файлов:", 0) 
    'Если пользователь не выбрал папку, завершаем приложение &H0001 + &H4000
    If objFolder Is Nothing Then Exit Do
    'Получаем путь к выбранной папке
    FldN = objFolder.Self.Path
    FoundColon = InStr(1,FldN,":",vbTextCompare)
    If FoundColon = 1 Then
        MsgBox "Вы выбрали некорректную папку размещения файлов попробуйте еще раз!"
    End if
Loop while(FoundColon = 1)

If objFolder Is Nothing Then
    MsgBox "Не выбран каталог размещения файлов"
Else

    If Not FSO.FolderExists(FldN) Then
        MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
        WScript.Quit
    End If
    
    Do
        Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Выберите каталог куда будут перемещаться файлы:", 0) 
        'Если пользователь не выбрал папку, завершаем приложение &H0001 + &H4000
        If objFolder Is Nothing Then Exit Do
        'Получаем путь к выбранной папке
        FldN1 = objFolder.Self.Path
        FoundColon = InStr(1,FldN1,":",vbTextCompare)
        If FoundColon = 1 Then
            MsgBox "Вы выбрали некорректную папку размещения файлов попробуйте еще раз!"
        End if
    Loop while(FoundColon = 1)
    
    If objFolder Is Nothing Then
        MsgBox "Не выбран каталог размещения файлов"
    Else
        
        If Not FSO.FolderExists(FldN1) Then
            MsgBox "Папка """ & FldN1 & """ не существует. ", vbExclamation, "Ошибка"
            WScript.Quit
        End If
        
        Dim NextCheck
        
        NextCheck = 0
        
        Erase FileMassiv
        reDim preserve FileMassiv(-1)
        'Запуск рекурсии по каталогу для нахождения файлов и помещения в массив FileMassiv() с полным путем нахождения
        Call CheckFolderInFolder (FldN &"\")
        'MsgBox Ubound(FileMassiv)
        If Ubound(FileMassiv,1) = -1 Then
            
            ''WScript.Echo "Файлов в данном каталоге нет" 
            NextCheck = 1
            
        End IF
        
        If NextCheck = 0 Then
            
            For Each Fl In FileMassiv
                Dim dd
                Set File = FSO.GetFile(Fl)
                FileName = File.Name
                FileParentFolder = File.ParentFolder
                NextCheck = 1
                IF LCase(FSO.GetExtensionName(File)) = LCase("jpg") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 12)
                    NextCheck = 0
                End IF
                
                IF LCase(FSO.GetExtensionName(File)) = LCase("mp4") Then 
                    Set Folder = CreateObject("Shell.Application").NameSpace(FileParentFolder)
                    dd = Folder.GetDetailsOf(Folder.ParseName(FileName), 3)
                    NextCheck = 0
                End IF
                
                If NextCheck = 0 Then
                    If dd = "" Then
                        D = "Нет_даты"
                    Else
                        
                        DMY = Split(dd,".")
                        YYYY = Split(DMY(2)," ")
                        D = DMY(0) & "." & DMY(1) & "." & YYYY(0)
                        
                    End If
                Else
                    call WhoTakeFile(File.Path, "Файл не определен","Перенос не осуществлен")
                    'D = "Формат_файла_не_определен"
                    NextCheck = 1
                End IF
                
                
                
                If NextCheck = 0 Then
                    
                    FlN = FldN1 &"\" &D &"\" &FileName
                    FlN1 = FldN1 &"\" &D &"\" &FileName
                    
                    If Not FSO.FolderExists(FldN1 &"\" &D) Then 

                        Dim tt
                        tt = "Будет создана папка " &D &" и помещен файл " &File.Name &" " &D &" = " &File.DateLastModified
                        'Создание папок по запросу
                        'ExitFromName = MsgBox (tt, 36, "Прекратить создание папки?") 
                        
                        If ExitFromName = 6 Then 
                            Exit For
                        End If  
                        
                        FSO.CreateFolder (FldN1 &"\" &D)
                    End If
                    
                    
                    If FSO.FileExists(FlN) Then
                        rr = "Файл " & File.Name & " уже существует в папке " & D & ". " & vbCr & "Перезаписать?"
                        'ExitFromName1 = MsgBox (rr, 36, "Внимание") 
                        
                        ExitFromName1 = 7
                        
                        If ExitFromName1 = 6 Then
                            FSO.DeleteFile FlN, True
                            call WhoTakeFile(File.Path, "Файл Перезатерт",FlN1)
                            File.Move FlN
                        Else
                            
                            Set File3 = FSO.GetFile(FlN)
                            
                            call WhoTakeFile(File.Path, "Скопирована копия",FlN1)
                            
                            Set objShell = CreateObject("Shell.Application")
                            Set objFolder = objShell.NameSpace(FldN1 &"\" &D) 'место назначения
                            objFolder.CopyHere Fl,8
                            'WScript.Sleep 60000 'даём время на скачивание (минута)
                            File.Delete
                            
                        End If
                    Else
                    'MsgBox File.Path
                        call WhoTakeFile(File.Path, "Файл Перенесен",FlN1)
                        File.Move FlN
                    End If
                End IF
                
            Next
        End IF
        
    End IF
    
    MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
    WScript.Quit

End If


Function CheckFolderInFolder (P1)

    'P1 - передаваемый параметр пути где необходима рекурсия возвращаемый заполненный массив FileMassiv(i)
    
    RetCode = 0
    
    If Ubound(FileMassiv) = -1 Then
        i = -1
    End IF
    
    Dim File2,CollectionFolder,CollectionFile,Folder5
    
    Set Folder5 = FSO.GetFolder(P1)
    Set CollectionFolder = Folder5.SubFolders
    Set CollectionFile = Folder5.Files
    
    If CollectionFile.count > 0 Then
        For Each File2 In CollectionFile
            ' Сообщение о файле при переборе
            i = i + 1
            reDim preserve FileMassiv(i)
            FileMassiv(i) = File2.Path
            'MsgBox File2.Path &" = " &i
            'WScript.Echo File2.Path &" Размерность =" &i &" Размер массива = " &Ubound(FileMassiv)
        Next
    End If
    
    For Each SubFolder In CollectionFolder
        call CheckFolderInFolder (SubFolder)
    Next

End Function


Sub WhoTakeFile(P1,P2,P3)
    
    'P1 - обрабатываемый файл путь
    'P2 - наименование операции
    'P3 - директория для переноса
    
    Dim File1
    
    YearNow = Split(TakeFolderData,"_")
    
    Dim FileTakeUser
    Dim OpenFileBuzyCheck
    
    
    Set FileTakeUser = FSO.GetFile(P1)
    
    On Error Resume Next
    
    If Not FSO.FileExists(FldN1 &"\" &"Протокол"  &".txt") Then
        Set OpenFileBuzyCheck = FSO.OpenTextFile(FldN1 &"\" &"Протокол"  &".txt", 8, True)
        
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        OpenFileBuzyCheck.WriteLine "* Журнал обработки                                                                                                                                                                                                                                                                                                           *"
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        OpenFileBuzyCheck.WriteLine "* Обрабатываемый файл                                                                                       * Дата и время выполнения  * Производимая операция* Директория размещения                                                                      * дата создания       * Дата изменения      * Дата открытия       *"
        OpenFileBuzyCheck.WriteLine "******************************************************************************************************************************************************************************************************************************************************************************************************************************"
        
        Set File1 = FSO.GetFile(FldN1 &"\" &"Протокол"  &".txt")
    Else
        Set File1 = FSO.GetFile(FldN1 &"\" &"Протокол"  &".txt")
        Set OpenFileBuzyCheck = FSO.OpenTextFile(File1, 8, True)
    End If
    
    If Err.Number = 0 Then
    
        Dim P(7)
        P(0) = FileTakeUser.Path
        P(1) = P2
        P(2) = P3
        P(3) = FileTakeUser.DateCreated
        P(4) = FileTakeUser.DateLastModified
        P(5) = FileTakeUser.DateLastAccessed 
        P(6) = " - "
        P(7) = now
        
        Dim L(7)
        L(0) = 105
        L(1) = 20
        L(2) = 90
        L(3) = 18
        L(4) = 18
        L(5) = 18
        L(6) = 70
        L(7) = 24
        
        For a = 0 To 7 Step 1
            Do
                'WScript.Echo "=" &P(a) &"="
                If L(a) = "" Then
                    Exit Do
                End If
                If Len(P(a)) < L(a) Then
                    P(a) = P(a)  &" "
                End If
                'If Len(P(a)) < L(a) Then
                '    P(a) = " "  &P(a) 
                'End If
            Loop While (Len(P(a)) < L(a))
        Next
        OpenFileBuzyCheck.WriteLine "* " &P(0) &" * " &P(7) &" * " &P(1) &" * " &P(2) &" * " &P(3) &" * " &P(4) &" * " &P(5) &" *"
        OpenFileBuzyCheck.Close
    Else
        OpenFileBuzyCheck.Close
    End IF
    
    Err.Clear
    On Error Goto 0
    
End Sub