Войти

Показать полную графическую версию : VBS - CDO.Mesage

Ragnazar
09-09-2012, 15:09
Отправляю Mail через скрипт

Option Explicit

Const cdoSendUsingPort = 2
Const cdoBasic = 1

Const strPartSchema = "http://schemas.microsoft.com/cdo/configuration/"

Dim strValue
Dim Server
Dim From
Dim strTo
Dim Subject
Dim CDOM

From = InputBox("Ваша почта:", "Mail", "User@site.ru")
Server = Split(From, "@")


If Not IsEmpty(strPassword) Then
strTo = InputBox("Почта получателя:", "Mail", "User@site.ru")
Subject = InputBox("Тема сообщения", "Mail", "Тема")
Set CDOM = WScript.CreateObject("CDO.Message")
CDOM.Configuration.Fields.Item(strPartSchema & "sendusing") = cdoSendUsingPort
CDOM.Configuration.Fields.Item(strPartSchema & "smtpauthenticate") = cdoBasic
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserver") = "smtp." & Server(1)
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserverport") = 25
CDOM.Configuration.Fields.Item(strPartSchema & "sendusername") = From
CDOM.Configuration.Fields.Item(strPartSchema & "sendpassword") = strPassword
CDOM.Configuration.Fields.Update

CDOM.To = strTo
CDOM.From = From
CDOM.Subject = Subject

Do
strValue = InputBox("Текст сообщения:", "Отправка почтового сообщения", "(пустая строка завершает ввод текста)")

If Len(strValue) = 0 Then
If MsgBox("Отправить?",1+32,"Mail") = vbOk then
CDOM.Send
MsgBox "Отправлено!",64,"Mail"
Else
MsgBox "Отменено!",48,"Mail"
WScript.Quit 0
End if
Exit Do
Else
CDOM.TextBody = CDOM.TextBody & vbCrLf & strValue
End If
Loop

Else
WScript.Echo "Password is not entered"
WScript.Quit
End If


Это только часть кода (Наиболее функциональная)
В самом конце скрипта
Вероятно на CDOM.send
Выдается ошибка
Не удалось отправить сообщение на SMTP-сервер.
Код ошибки транспорта 0х80040217.
Отклик сервера: not available

Сервер smtp - smtp.yandex.ru
Iska
09-09-2012, 16:48
Ragnazar, приводите код, достаточный для воспроизведения ошибки.
Ragnazar
09-09-2012, 18:28
Использовалась почта Yandex


Option Explicit

Const cdoSendUsingPort = 2
Const cdoBasic = 1

Const strPartSchema = "http://schemas.microsoft.com/cdo/configuration/"

Dim strValue
Dim Server
Dim From
Dim strTo
Dim Subject
Dim CDOM

From = InputBox("Ваша почта:", "Mail", "User@site.ru")
Server = Split(From, "@")


Const READYSTATE_COMPLETE = 4

Dim objIE
Dim objWindow

Dim boolDone
Dim strPassword


Set objIE = WScript.CreateObject("InternetExplorer.Application", "IE_")

With objIE
.Navigate "about:blank"

Do
WScript.Sleep 100
Loop Until Not .Busy And .ReadyState = READYSTATE_COMPLETE

.AddressBar = False
.MenuBar = False
.StatusBar = False
.ToolBar = False

With .Document
.write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Strict//EN"">" & vbCrLf & _
"<html>" & vbCrLf & _
" <head>" & vbCrLf & _
" <meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>" & vbCrLf & _
" <meta http-equiv='Content-Language' content='ru'>" & vbCrLf & _
" <title>SaVlad @-mail v2</title>" & vbCrLf & _
" <style>" & vbCrLf & _
" body {" & vbCrLf & _
" margin: 1em 1em 1em 1em;" & vbCrLf & _
" color: MidnightBlue;" & vbCrLf & _
" background-color: LightSteelBlue" & vbCrLf & _
" }" & vbCrLf & _
" </style>" & vbCrLf & _
" </head>" & vbCrLf & _
" <body>" & vbCrLf & _
" <label for='sPassword' accesskey='p'>Enter <u>p</u>assword:</label>" & vbCrLf & _
" <input type='password' name='sPassword' id='sPassword' size='50'>" & vbCrLf & _
" <input type='button' value='OK' name='OK'>" & vbCrLf & _
" <input type='button' value='Отмена' name='Cancel'>" & vbCrLf & _
" </body>" & vbCrLf & _
"</html>"

.getElementsByName("OK").item(0).onclick = GetRef("IEButtonClick")
.getElementsByName("Cancel").item(0).onclick = GetRef("IEButtonClick")

With .getElementByID("sPassword")
.onKeyPress = GetRef("IEOnKeyPress")
.focus
End With

Set objWindow = .parentWindow

With .Body
objWindow.resizeTo .scrollWidth + 25, .scrollHeight + 32
objWindow.moveTo (objWindow.screen.availWidth - .offsetWidth) \ 2, (objWindow.screen.availHeight - .offsetHeight) \ 2
End With

Set objWindow = Nothing

'.getElementByID("sPassword").focus
End With

.Visible = True

boolDone = False
strPassword = Empty

Do
WScript.Sleep 100
Loop Until boolDone

On Error Resume Next
.Quit
On Error Goto 0
End With

Set objIE = Nothing


If Not IsEmpty(strPassword) Then
strTo = InputBox("Почта получателя:", "Mail", "User@site.ru")
Subject = InputBox("Тема сообщения", "Mail", "Тема")
Set CDOM = WScript.CreateObject("CDO.Message")
CDOM.Configuration.Fields.Item(strPartSchema & "sendusing") = cdoSendUsingPort
CDOM.Configuration.Fields.Item(strPartSchema & "smtpauthenticate") = cdoBasic
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserver") = "smtp." & Server(1)
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserverport") = 25
CDOM.Configuration.Fields.Item(strPartSchema & "sendusername") = From
CDOM.Configuration.Fields.Item(strPartSchema & "sendpassword") = strPassword
CDOM.Configuration.Fields.Update

CDOM.To = strTo
CDOM.From = From
CDOM.Subject = Subject

Do
strValue = InputBox("Текст сообщения:", "Отправка почтового сообщения", "(пустая строка завершает ввод текста)")

If Len(strValue) = 0 Then
If MsgBox("Отправить?",1+32,"Mail") = vbOk then
CDOM.Send
MsgBox "Отправлено!",64,"Mail"
Else
MsgBox "Отменено!",48,"Mail"
WScript.Quit 0
End if
Exit Do
Else
CDOM.TextBody = CDOM.TextBody & vbCrLf & strValue
End If
Loop

Else
WScript.Echo "Password is not entered"
WScript.Quit
End If

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

'=============================================================================
Sub IE_OnQuit
boolDone = True
End Sub
'=============================================================================

'=============================================================================
Sub IEButtonClick
Select Case Me.Name
Case "OK"
strPassword = objIE.Document.getElementByID("sPassword").Value
boolDone = True
Case "Cancel"
boolDone = True
Case Else
' Nothing to do
End Select
End Sub
'=============================================================================

'=============================================================================
Sub IEOnKeyPress
Select Case Me.ownerDocument.parentWindow.event.keyCode
Case 13
strPassword = Me.Value
boolDone = True
Case 27
boolDone = True
Case Else
' Nothing to do
End Select
End Sub
'=============================================================================
Iska
11-09-2012, 01:47
Ragnazar, воспользовавшись выложенным Вами кодом я отправил сообщение с одного адреса и получил на другой. Без ошибки.

Проверяйте, что Вы использовали в коде, что Вы вводили и насколько оно соотносится с требованиями использованного Вами smtp-сервера.



© OSzone.net 2001-2012