间歇性的“传输无法连接到服务器” CDO错误

Question

I am writing an application that sends emails to an admin when there is a problem with the data. The account it's sending through is a Network Solutions SMTP server.

The code works most of the time, but about 1 out of 10 sends fail with the error -2147220973 "The transport failed to connect to the server".

Any suggestions on how to handle this?

Set imsg = CreateObject("cdo.message")
Set iconf = CreateObject("cdo.configuration")
Set Flds = iconf.Fields

With Flds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.OurCompany.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2525
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me@OurCompany.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
  .Update
End With

With imsg
  Set .Configuration = iconf
  .To = "me@MyEmail.com" 'CMemail
  .From = "resupport@OurCompanycom"

  .Subject = ACT
  .HTMLBody = "Notification for " & CTName & " of " & CTCname & " " & ACT & ". You must manually Notify them about new docs for " & pname & ". " _
            & "<br>Tell " & CTName & " to '" & Nz(DLookup("Notify", "TBLINVOICESETTINGS"), "") & " " & PRName & "_" & pname & ".pdf'"

  .Send
End With

Set imsg = Nothing
Set iconf = Nothing

Answer 1

smtpserverport应该为25，是否被防火墙阻止？

Answer 2

This piece of code executes correctly :

Sub SMail(pTO As String, pSB As String, pBO As String, pAT As String)
On Error GoTo ErrH: Dim mm As CDO.Message: Set mm = New CDO.Message
mm.Configuration.Fields(cdoSMTPUseSSL) = "True"
mm.Configuration.Fields(cdoSendUsingMethod) = 2
mm.Configuration.Fields(cdoSMTPAuthenticate) = 1
mm.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
mm.Configuration.Fields(cdoSendUserName) = "MyID"
mm.Configuration.Fields(cdoSendPassword) = "MyPW"
'mm.Configuration.Fields(cdoSMTPConnectionTimeout) = 20
'mm.Configuration.Fields(cdoSMTPServerPort) = 25
mm.Configuration.Fields.Update
mm.From = "MyID"
mm.To = pTO
mm.Subject = pSB
mm.TextBody = pBO
mm.AddAttachment (pAT)
mm.send
ErrH: If Err Then MsgBox (Err.Number & " : " & Err.Description)
Set mm = Nothing
End Sub