错误代码:80040213源CDO.Message.1连接失败

时间:2014-06-25 19:52:23

标签: excel vbscript cdo.message

这真的只是我的第二个VBS剧本,所以要温柔......我确实做了任何个人或公司相关的事情我确信所有这些领域都是正确的。 SMTP服务器是正确的我与提供商进行了双重检查,因为这是我在其他网站上找到的第一个原因。此脚本还将从某个单元格中提取信息并将其粘贴到正文中...任何帮助将不胜感激!它也说错误是在第46行,即“ObjSendMail.Send”。一切都有效,除了电子邮件部分......

    Dim ObjSendMail
Set ObjSendMail = CreateObject("CDO.Message")
Set objExcel = CreateObject("Excel.Application")
StopDate = DateAdd("d", -1 - Weekday(Date), Date)
StartDate = StopDate-13

Dim xlApp
Dim xlWkb
Dim monthEnd
Set xlApp = CreateObject("excel.application")

Set xlWkb = xlApp.Workbooks.Open("******")
xlWkb.RunAutoMacros 1
xlApp.Run ("UpdateAll")
monthEnd = xlApp.cells(2,7).value
xlApp.ActiveWorkbook.SaveAs strSaveFile & "Monthly Revenue Report " & Year(Now) & "." & Month(Now) & "." & Day(Now) & ".xls", 56 

xlApp.Quit
Set xlWkb = Nothing
Set xlApp = Nothing

WScript.Sleep 10000
mailSubject = "Monhtly Revenue Report " & PrevMonthName
mailBody = "The Monthly Revenue Report is no ready. Month End: " & monthEnd

ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 240
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "********"
ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "********"
ObjSendMail.Configuration.Fields.Update

ObjSendMail.To = "*********"
ObjSendMail.Subject = mailSubject
ObjSendMail.From = "*******"
'ObjSendMail.HTMLBody = "this is the body"
ObjSendMail.TextBody = mailBody
ObjSendMail.Send


'Set ObjSendMail = Nothing

3 个答案:

答案 0 :(得分:1)

如有疑问,请阅读documentation。 Office365使用提交端口(587 / tcp)进行邮件提交。替换这个:

ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

用这个:

ObjSendMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587

并且错误应该消失(前提是您的网络允许到端口587 / tcp的出站连接)。

您可以使用nmapscanlinePortQry等端口扫描程序测试端口的可访问性,或使用telnet手动测试端口的可访问性:

telnet smtp.office365.com 587

提供商最有可能阻止到端口25 / tcp的出站连接,作为防止/减少僵尸网络垃圾邮件的措施。

答案 1 :(得分:1)

以下代码适用于smtp.office365.com。你要指示smtpusessl = true,但你没有指定端口,否则你会得到错误5.7.57。

    Sub SMPTTest2()
    Set emailObj = CreateObject("CDO.Message")

    emailObj.From = "name@myaddress.com"
    emailObj.To = "name@youraddress.com"
    emailObj.Subject = "Test CDO"
    emailObj.TextBody = "Test CDO"
    'emailObj.AddAttachment "c:\windows\win.ini"

    Set emailConfig = emailObj.Configuration


    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
    'Exclude the following line    
    'emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name@myaddress.com"
    emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
    emailConfig.Fields.Update

    emailObj.Send

    If Err.Number = 0 Then MsgBox "Done"
    End Sub

答案 2 :(得分:0)

来自Unknown email code from CDO.Message send method

CDO_E_FAILED_TO_CONNECT 0x80040213L The transport failed to connect to the server.

如果使用SSL,端口通常为465。