[решено] Отправка почты на VBS (нужна помощь в доработке скрипта)

[registeruser1]

Уважаемые, помогите еще с одним вопросом если не сложно.
Нашел тут случайно скриптик типа как я понял отправки почты.
Сам я в этом не волоку, потому и прошу, посмотрите пож-ста его,
Я так думаю что он не законченный или я непонял как им пользоваться...
По крайней мере подставлял все данные и не работает...

Вот сам скрипт -
Option Explicit
Dim objFSO, objFile
Dim strPath2SourceFolder, strMessage, strheadlist
Dim intPrefixб Count, Message, iConf, Flds

strPath2SourceFolder = "директория расположения контролируемых файлов"
strMessage = vbNullString

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strPath2SourceFolder).Files
if UCase(objFSO.GetExtensionName(objFile.Name)) = UCase("dbf") And _
DateDiff("D", objFile.DateLastModified, Now) = 0 Then

Count=Count+1
strMessage = strMessage & Count & ". " & objFSO.GetFileName(objFile.Name) & vbCrLf

Attach = "" & strPath2SourceFolder & objFSO.GetFileName(objFile.Name) _
& "" ' * Получаем имя файла с путем

End If

Message.AddAttachment (Attach) ' * Описываем вложение для отправки

next

strMessage = "Следующие файлы были изменены:" & vbCrLf & strMessage
strMessage = strMessage & vbCrLf & "Всего измененных файлов: "& Count

if Count > 0 Then
' непосредственно блок работы с почтой ---------------------------------------------------------------------------------
Set Message = CreateObject("CDO.Message")
Message.To = "кому@mail.ru"
Message.From = "от_кого@mail.ru"
Message.Subject = "RE: ! Warning!"
Message.TextBody = strMessage
Message.BodyPart.Charset = "windows-1251"

Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.ru"
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2525
Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Ваш_пароль"
Flds.Update
Message.Configuration = iConf
Message.Send

End If

[Ivan Bardeen]

Вы лучше задачу объясните - что должен делать скрипт для ваших задач

[registeruser1]

Ivan Bardeen
...Ну я сейчас пользуюсь "Blat.exe", думаю что это альтернатива ему только на vbs, и хочу подробнее узнать как он работает и что в нем не так на данный момент.
Благодарю...

[Ivan Bardeen]

...Ну я сейчас пользуюсь "Blat.exe", думаю что это альтернатива ему только на vbs, и хочу подробнее узнать как он работает и что в нем не так на данный момент.
Благодарю... »
Все же повторю вопрос, - какую задачу вы хотите решить? (мне неохота разбирать чужой код под непонятно какие задачи)

[registeruser1]

Ivan Bardeen
Использую "Blat.exe" в организации для отправки логов и отчетов (не большой сервак завел специально для этого), начальник ругается на этот "Blat.exe" (не доверяет таким утилитам в принципе, когда не видит исполняемый код), но выполняемые функции сервера важны и не хочется из-за не доверия начальника выключать сервак. Вот и ищу по сей день альтернативу "Blat.exe", а тут как раз весь код виден и думаю что начальник мой успокоится посмотрев код.
Просто сам в скриптах не разбираюсь, вот и хотелось бы разъяснений как он работает, сам не допер пока...
"Blat.exe" у меня в основном берет из файла отчетов (txt) и отправляет в html-формате (само тело письма в html) письмо.
Адресатов берет тоже из файла (txt)... И любые указанные в параметрах "Blat.exe" вложения может отправлять...

Заранее благодарю...

[registeruser1]

Нашел вроде бы пишут что рабочий скрипт, но он не работает, сразу ругается...
В чем именно грабли не пойму...

Set objMsg = CreateObject("CDO.Message")
Set Config = CreateObject("CDO.Configuration")
Set Config = objMsg.Configuration
objMsg.From = "from@domain.ru"
objMsg.To = "to@domain.ru"
objMsg.Subject = "Test sending email from sсriрt"
objMsg.Textbody = "This is a body of E-mail."
Config("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Config("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-server"
Config("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Config("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Config("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
Config("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass"
Config.Fields.Update
objMsg.Send

[Ivan Bardeen]

Вот, рабочий VBS скрипт, без аутентификации на smtp сервере(так проще)

Set objEmail = CreateObject("CDO.Message")
objEmail.From = "Script@domain.local"
objEmail.To = "bardeen@domain.com"
objEmail.Subject = "Тема письма "
objEmail.Textbody = "содержимое письма "
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.domain.local"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

[registeruser1]

Ivan Bardeen
Спасибо большое, очень помогли мне...

[buloshnik]

НУ вот у меня с вашими скриптами ничего не получалось,выдавал ошибку 8004023,но в итоге просто пришлось поменять smtp порт,в итоге:



Set objMsg = CreateObject("CDO.Message")
Set Config = CreateObject("CDO.Configuration")
Set Config = objMsg.Configuration
objMsg.From = "name@mail.ru"
objMsg.To = "name@gmail.com"
objMsg.Subject = "Test sending email from sсriрt"
objMsg.Textbody = "This is a body of E-mail."
Config("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Config("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "94.100.177.1" 'это ip сервера smtp.mail.ru
Config("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2525
Config("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Config("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name@mail.ru"
Config("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
Config.Fields.Update
objMsg.Send

[alek2012]

всем привет. Есть такой вот скрипт для отправки почты по маске с расширением pdf из определенной папки.
Мне нужно чтобы скрипт оправлял все файлы по маске которые появились за прошедший 1 час не только из одной папки, а и со всех его подпапок, в том числе и скрытых.
Помогите разобраться как реализовать.


DIM Mas()
Set objShellApp = CreateObject("Shell.Application")
FolderPath = "C:\FOLDER\"
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
objFolderItems.Filter 64, "*.pdf"
n = 0
For Each objFolderItem In objFolderItems
n = n +1
ReDIM Preserve Mas(n)
Mas(n)=objFolderItem.Path
Next

Set oMyMail = CreateObject("CDO.Message")
oMyMail.BodyPart.Charset = "windows-1251"
oMyMail.To = "admin@domain.local"
oMyMail.From = "admin@domain.local"

lft=LBound(Mas)
rgt=UBound(Mas)

For i=lft To rgt
oMyMail.AddAttachment Mas(i)
Next

oMyMail.Subject = "нужные файлы во вложении"
oMyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.1.0.155"
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "domain\user"
omyMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "true"

oMyMail.Configuration.Fields.Update
oMyMail.Send

[Iska]

которые появились за прошедший 1 час »
Кто или что будет отслеживать или определять этот час? По каким принципам?

[alek2012]

нужно отследить файлы pdf которые появились за прошедший час времени и их отправить

[Iska]

alek2012, я тоже умею повторять, смотрите: кто или что будет отслеживать или определять этот час? По каким принципам?

[alek2012]

можно по дате модификации каталога например каждый час проверять условием

If DatePart("yyyy",Now)=DatePart("yyyy",objDIR.DateLastModified) And _
DatePart("m",Now) =DatePart("m",objDIR.DateLastModified) And _
DatePart("d",Now) =DatePart("d",objDIR.DateLastModified) And _
DatePart("h",Now) =DatePart("h",objDIR.DateLastModified) Then

Set oMyMail = CreateObject("CDO.Message")

и в таком случае отправить файлы из каталога

а если изменений не было то отправить что файлов нет

например
Else
Set oMyMail = CreateObject("CDO.Message")
ну и отправить что файлов нет

главная суть вопроса как вытягивать файлы по маске из всех внутренних подкаталогов в том числе и скрытых

[Iska]

можно по дате модификации каталога например каждый час проверять условием »
Создали/удалили. Дата модификации каталога изменилась. А по сути — всё осталось как было.

Вы сразу начинаете решать, а я спрашиваю про принципы определения.

главная суть вопроса как вытягивать файлы по маске из всех внутренних подкаталогов в том числе и скрытых »
С этим проблем нет. Если Вас интересует — могу привести код.

[alek2012]

приведите пожалуйста код

[alek2012]

Создали/удалили. - ручками специально никто в этом каталоге создавать/удалять не будет, по этому мое условие по дате модификации подходит

[Iska]

приведите пожалуйста код »
Например, так:
Option Explicit

Dim arrFiles
Dim strFile

arrFiles = GetFilesByMask("E:\Песочница", "*.pdf")

For Each strFile In arrFiles
WScript.Echo strFile
Next

WScript.Quit 0
'=============================================================================

'=============================================================================
Function GetFilesByMask(strSourceFolder, strMask)
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2

Dim strContent


With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFolder) Then
With WScript.CreateObject("WScript.Shell").Exec("""%comspec%"" /c ""dir /a:-d /b /s """ & strSourceFolder & "\" & strMask & """""")
If .Status <> WshFailed Then
strContent = ""

Do
strContent = strContent & .StdOut.ReadAll()
Loop Until .Status = WshFinished
End If
End With

GetFilesByMask = Split(StrConvert(strContent, "windows-1251", "cp866"), vbCrLf)
Else
WScript.Echo "Source folder [" & strSourceFolder & "] not found."
WScript.Quit 1
End If
End With
End Function
'=============================================================================

'=============================================================================
' HKEY_CLASSES_ROOT\MIME\Database\Charset
' cp866, windows-1251, koi8-r, unicode, utf-8, _autodetect
'=============================================================================
Function StrConvert(ByVal strText, ByVal strSourceCharset, ByVal strDestCharset)
Const adTypeText = 2
Const adModeReadWrite = 3


With WScript.CreateObject("ADODB.Stream")
.Type = adTypeText
.Mode = adModeReadWrite

.Open

.Charset = strSourceCharset
.WriteText strText

.Position = 0
.Charset = strDestCharset
StrConvert = .ReadText

.Close
End With
End Function
'=============================================================================


по этому мое условие по дате модификации подходит »
Делайте!