Отклик сервера 550 5.1.1 при отправке письма под CDO - VB
Формулировка задачи:
Есть в процедуре перехват на Err, но при попытке отправить на заведомо ложный адрес он не
срабатывает. Выпрыгивает MsgBox содержания:
"Сервер отклонил один или несколько адресов пользователей. Отклик сервера
550 5.1.1 <[ложный адрес]>"
Как, все же, осуществить перехват подобных собщений? Получается сообщение
вызывается не объектом ERR?
<EM>Очень заранее благодарен.</EM>
Решение задачи: «Отклик сервера 550 5.1.1 при отправке письма под CDO»
textual
Листинг программы
Dim cdoConfig As New CDO.Configuration
Dim cdoMessage As New CDO.Message
...
sch = "http://schemas.microsoft.com/cdo/configuration/"
With cdoConfig.Fields
.Item(sch & "sendusing") = sendusing
.Item(sch & "smtpserver") = smtpserver
.Item(sch & "smtpserverport") = smtpserverport
.Item(sch & "sendusername") = sendusername
.Item(sch & "sendpassword") = sendpassword
.Item(sch & "smtpauthenticate") = smtpauthenticate
.Item(sch & "smtpusessl") = smtpusessl
.Item(sch & "smtpconnectiontimeout") = smtpconnectiontimeout
.Update
End With
...
With cdoMessage
Set .Configuration = cdoConfig
.From = strEmailAdmin
.Subject = stSubject
If TipeMsg = "TextBody" Then
.TextBody = strBodyText
Else
.HTMLBody = strBodyText
End If
.TextBodyPart.Charset = stCharset
If Len(Trim(FileAtach)) > 0 Then .AddAttachment FileAtach
.Fields("urn:schemas:mailheader:disposition-notification-to") = strEmailAdmin
'.Fields("urn:schemas:mailheader:return-receipt-to") = strEmailAdmin
.DSNOptions = cdoDSNSuccessFailOrDelay
On Error GoTo FailSending_senddelivary
i = LBound(ArrPost)
FlagAction_senddelivary:
.To = ArrPost(i)
.Fields.Update
.Send ' тут и не происходит заполнение ERR, зато меседжБокс практически убивает наповал, сбивая весь автоматический процесс. Причем если, действительно вызвать ERR, выключив там соединение, то все ладом. Ну код сообщения я выложил выше.
....
FailSending_senddelivary:
If stError = "" Then
stError = CStr(Err.Description)
Call Err.Clear
...
Resume FlagAction_senddelivary