CDO.Message No Longer Working (Gmail) - Failed to Transport Error

[slam19s]

Hi,



About three months ago my VB function using gmail to send email stopped working. I get the following error: "Run-time error '2147220973 (80040213)' The transport failed to connect to the server."

I've tried to the following with no success:

-Turning off antivirus/firewall
-Change send and from email addresses
-Use a different outgoing port (I've tested the ports using telnet and all is working fine)

Fyi, my system is Win 7 64 bit. Any help would be greatly appreciated.

My vb code is as follows:

Public Sub GmailSend()
  Dim cdomsg
  Set cdomsg = CreateObject("CDO.message")
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/con...tion/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/con...ion/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/con...smptserverport") = 587 '995, 465, 587
    .Item("http://schemas.microsoft.com/cdo/con...ion/smtpusessl") = 1
    .Item("http://schemas.microsoft.com/cdo/con...tpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/con...nectiontimeout") = 30
    .Item("http://schemas.microsoft.com/cdo/con...n/sendusername") = "(full sender email address)"
    .Item("http://schemas.microsoft.com/cdo/con...n/sendpassword") = "(full sender password)"
    .Update
  End With
  ' build email parts
  With cdomsg
    .To = "(full recipient email address)"
    .From = "(full sender email address)"
    .Subject = "subject"
    .Addattachment "c:\temp\test.xls"
    .TextBody = "body text"
    .Send
  End With

  Set cdomsg = Nothing
End Sub

[slam19s]

For anyone that was following this, I was not able to figure out what happened that caused the code to stop working. However, I did find a separate code on utteraccess which worked.

Public Sub GmailSend()
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/con...tpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/con...n/sendusername") = "(full sender email address)"
.Item("http://schemas.microsoft.com/cdo/con...n/sendpassword") = "(full sender password)"
.Item("http://schemas.microsoft.com/cdo/con...ion/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/con...tion/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/con...smtpserverport") = 465 'NOT 25 OR 587 'Use SSL for the connection (False or True)
.Item("http://schemas.microsoft.com/cdo/con...ion/smtpusessl") = True
.Update
End With

With iMsg
Set .Configuration = iConf
.To = "(recipient email address)"
.CC = ""
.BCC = ""
.From = "(sender email address)"
.Addattachment "c:\temp\test.xls"
.Subject = "subject text"
.TextBody = "body text"
.Send
End With
End Sub

[pbaldy]

Thanks for posting back with the solution. Welcome to the site by the way!