Reputation: 31
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") = "[email protected]"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Update
End With
With imsg
Set .Configuration = iconf
.To = "[email protected]" '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
Upvotes: 0
Views: 3869
Reputation: 1
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
Upvotes: -1