 |
|
VBS - CDO.Mesage
Отправляю 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 |
Ragnazar, приводите код, достаточный для воспроизведения ошибки.
|
Использовалась почта 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
'=============================================================================
|
Ragnazar, воспользовавшись выложенным Вами кодом я отправил сообщение с одного адреса и получил на другой. Без ошибки.
Проверяйте, что Вы использовали в коде, что Вы вводили и насколько оно соотносится с требованиями использованного Вами smtp-сервера.
|
Время: 19:06.
© OSzone.net 2001-