Тема: VBS: путь папок из даты
Доброго вам.
задача прилепленного ниже скрипта, найденного здесь, делать архив из папки и отправлять на мыло. Необходима некоторая корректировка и доработка, помогите плиз
1) исключить отправку файла лога, отправлять только созданный архив
2) и наверное самое необходимое прописать меняющийся путь к папке из которой делать архив, а именно, путь такой C:\папка\2010\10\28.html -> C:\ папка \год \ месяц \ файл дата.html.
Задача в идеале такова. Нужно каждый день из C:\ папка \ отправлять файлы за вчерашний день упакованными в архиве. Получается если сегодня 28.10.2010 нужно отправить файл C:\папка\2010\10\27.html Ну и понятно с переменной месяца и года путь должен меняться.
заранее спасибо за помощь
Dim dtNow
Dim archname
Dim LogPath 'Путь к файлу лога этого скрипта
Dim LogFile 'Поток текстового файла лога этого скрипта
Dim fso
Dim fldrpath
Dim folder
Dim filelist
Dim curfile
Dim result
Dim messbody
'Имя архива, без даты.
archname = "name.rar"
'Работаем с датой.
dtNow = Now()
archdfile = Year(dtNow) & Right("00" & CStr(Month(dtNow)), 2) & Right("00" & CStr(Day(dtNow)), 2) & "_" & archname
'Путь к файлам для добалвения в архив.
fldrpath= "C:\Temp\"
'Путь и имя файла лога.
LogPath = (fldrpath & "1.txt")
'Скрипт для отправки сообщения пользователям и архивирования файла.
filePath = (fldrpath & "1.txt")
'Путь куда архивируем и имя файлаю archPath = ("H:\distrib\Panasonic\" & archdfile)
archway= "C:\"
archPath = ( archway & archdfile )
'Путь до прграммы архиватора.
winRarPath = """C:\Program Files\WinRAR\WinRAR.exe"""
'Тема емаил сообщения.
themes = "Отправляю копию " & archdfile & " архива файла " & filePath
'Тело сообщения.
bodytext = "Отправляю архивную копию файла" & archdfile & " на почту "
'Укажем нужную кодировку.
charset = "windows-1251"
'Тут указываем от кого отправляются сообщения.
sender = "mail"
'Список или одного получателя кому отправлять сообщения. Есди нужно указать несколько то через запятую.
recipients = "mail"
'Пароль пароль для отправителя
Passwd = "пасс"
'Сервер smtp
host = "smtp.yandex.ru"
'Архивация файла.
Set fs = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run winRarPath & " a " & archPath & " " & filePath, 0, True
'Пишем лог.
Set FSO = CreateObject("Scripting.FileSystemObject")
IF fso.FileExists(LogPath) Then
Set LogFile = FSO.CreateTextFile(LogPath)
LogFile.WriteLine "============Начало лога.======================"
LogFile.WriteLine (Now)
LogFile.WriteLine "============Что архивируем.======================"
LogFile.WriteLine (filePath)
set fso = createobject("Scripting.FileSystemObject")
do while not fso.folderexists(fldrpath)
loop
set folder=fso.GetFolder(fldrpath) 'установим папку
set filelist=folder.files 'прочитаем в коллекцию все подпапки
For Each curfile in filelist 'для каждой подпапки сделаем следующее:
result = result & curfile.name & "; Атрибуты: " & curfile.attributes & "; Дата создания: " & curfile.DateCreated & _
"; Дата посл. доступа: " & curfile.DateLastAccessed & "; Дата последнего изменения: " & curfile.DateLastModified & _
"; Диск: " & curfile.drive & "; Находится в: " & curfile.parentfolder & _
"; Полный путь: " & curfile.path & "; Размер: " & curfile.size/1024 & " кб; Тип: " & curfile.type
result=result & vbcrlf & vbcrlf 'думаю из названий назначение функций понятно
Next
LogFile.Write "Здесь записаны результаты опроса папки " & fldrpath & " и всех доступных фаилов" 'напишем
LogFile.writeblanklines 2
LogFile.write "Обнаружено: " & filelist.count & " фаилов" & vbcrlf & result 'ну и собственно результаты
LogFile.WriteLine "============Файл архива, с датой.======================"
LogFile.WriteLine (archPath)
LogFile.WriteLine "============Конец лога.======================"
LogFile.WriteLine (Now)
LogFile.Close
End if
WScript.Sleep 60
set fso = createobject("Scripting.FileSystemObject")
do while not fso.folderexists(fldrpath)
loop
set folder=fso.GetFolder(fldrpath) 'установим папку
set filelist=folder.files 'прочитаем в коллекцию все подпапки
For Each curfile in filelist 'для каждой подпапки сделаем следующее:
messbody = messbody & curfile.name
messbody=messbody & vbcrlf 'думаю из названий назначение функций понятно
Next
Sendmail
Sub sendmail
Set objEmail = CreateObject("CDO.Message")
objEmail.From = sender 'Тут указываем от кого отправляются сообщения.
objEmail.To = recipients 'Список или одного получателя кому отправлять сообщения.
objEmail.Subject = themes 'Тема письма.
objEmail.BodyPart.CharSet = charset
objEmail.Textbody = bodytext & vbcrlf & "Обнаружен: " & filelist.count & "-файл." & vbcrlf & messbody 'Само письмо!
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = sender 'Учетная запись.
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Passwd 'Пароль.
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = host 'Сервер.
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Порт исходящего сервера.
objEmail.AddAttachment archPath
objEmail.AddAttachment LogPath
objEmail.Configuration.Fields.Update
objEmail.Send
End sub
