Мой первый скрипт VBS

Заебся делать руками, а главное помнить про это каждую неделю....
Поставил задачу. Решил. Счастлив.

paragraph_text

Заебся делать руками, а главное помнить про это каждую неделю....
Поставил задачу. Решил. Счастлив.

Задача: собрать файлы с датой создания <= 7 дней, скопировать в папку, заархивировать папку и выслать архив по эл. почте.

Решение скрипт:

Dim objFolder
Dim colFiles     ' list of files
Dim objFile     ' file
adress1 = "Иванов Петя " ' E-Mail отправителя
adress2 = "PavelIvanov@mylo.ru" ' E-Mail получателя

' собираем имя папки из текущей даты
segodnya = now()
mm = Month(segodnya)
dd = Day(segodnya)
if Month(segodnya) < 10 then
   mm = "0"&Month(segodnya)
end if
 
if Day(segodnya) < 10 then
   dd = "0"&Day(segodnya)
end if

' создаем папку по дате 20191010
datefolder = "111\"&Year(segodnya)&mm&dd 
With CreateObject("Scripting.FileSystemObject")
        .Createfolder datefolder
End With

' копируем файлы в папку для сжатия
Const OverwriteExisting = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "RECEIVE\*" , datefolder, OverwriteExisting

     ' Папка Статистики
statfolder = "%dir%\STS\"
Set objFolder = objFSO.GetFolder(statfolder)
Set colFiles = objFolder.Files

' дата для проверки
datestat7 = now()-7
mm7 = Month(datestat7)
dd7 = Day(datestat7)
if Month(datestat7) < 10 then 
 mm7 = "0"&Month(datestat7)
end if
 
if Day(datestat7) < 10 then
   dd7 = "0"&Day(datestat7)
end if

datestat = dd7&"."&mm7&"."&Year(datestat7)

' копируем файлы по дате моложе или равно 7 дней

For Each objFile in colFiles
  
 if CDate(datestat) < objFile.DateLastModified then
     objFSO.CopyFile objFile.Path, datefolder&"\", OverwriteExisting
 end if
Next

' Архивация

Set objShell = CreateObject("WScript.Shell")

NameArx = Year(segodnya)&mm&dd&".zip"

str7zarx = "7z a -r "&NameArx&" "&datefolder
objShell.run str7zarx
'WScript.Quit

' Оптравляем почту.........

FileMail = "%dir%"&NameArx

Const cdoSendUsingPickup = 1  
Set objMessage = CreateObject("CDO.Message")  
objMessage.Subject = "Сататистика ////////"  
objMessage.From =  adress1 
objMessage.To = adress2
objMessage.TextBody = "Очередная порция статистики ......" 
CreateObject("WScript.Shell").Popup FileMail, 2, "Title"
objMessage.AddAttachment(FileMail)
' Секция настроек SMTP сервера для отправки почты.  
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  
' Имя или IP адрес SMTP Server 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.10.10.101" 
' Тип используемой авторизации, NONE, Basic (Base64 encoded), NTLM 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = NONE 
' SMTP server 
'objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.yandex.ru"  
' Авторизация на SMTP server 
'objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "secret.abc" 
' Пароль SMTP server 
'objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*********" 
' Порт SMTP Server port (обычно 25, но может быть и другим)  
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  
' Использование SSL для соединения (False или True)  
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 
' Время ожидания соединения с почтовым сервером 
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 
' Сохранить настройки CDO для отправки сообщения 
objMessage.Configuration.Fields.Update 
' Отправить созданное почтовое сообщение с вложением по указанному адресу 
objMessage.Send 
'Wscript.Quit

' Удаляем папку с файлами статистики за период и перемещаем архив

objFSO.Deletefolder datefolder
objFSO.MoveFile NameArx, "111\"

Wscript.Quit

Добавить комментарий