Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Sending Gmail using vba Send error

Status
Not open for further replies.
Kim296

Kim296

MIS
Aug 24, 2012
98
US
Good Morning, I have been trying to figure out how to send gmail using vba in Microsoft Access. I feel like the below code is correct as it's the same on every tutorial, instructions and research blog that I've found over the past week. I feel like I'm missing something else that I should be doing. I have enabled the IMAP on my google account. I have turned on 2 step authentication and received the APP password.

The error that I keep getting says: "The transport failed to connect to the server"

Any research direction or help on this issue is appreciated.

Code: 
Private Sub sendgmail_Click()

    Dim newMail As CDO.Message
    Dim mailConfiguration As CDO.Configuration
    Dim fields As Variant
    Dim msConfigURL As String
    
    On Error GoTo errHandle
    
    Set newMail = New CDO.Message
    Set mailConfiguration = New CDO.Configuration
    
    mailConfiguration.Load -1
    
    Set fields = mailConfiguration.fields
    
    With newMail
        .Subject = "Testing Gmail Sending ability"
        .From = "enter_from_email"
        .To = "enter_to_email"
        .CC = ""
        .BCC = ""
        ' To set email body as HTML, use .HTMLBody
        ' To send a complete webpage, use .CreateMHTMLBody
        .TextBody = "This is a test email."
        
    End With
    
    msConfigURL = "[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration"[/URL]
    
    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
        
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
        
        .Item(msConfigURL & "/sendusername") = "enter_gmail"
        .Item(msConfigURL & "/sendpassword") = "enter_gmail_App_Password"
        
        .Update
    
    End With
    
    newMail.Configuration = mailConfiguration
    newMail.Send
    
    MsgBox "E-Mail has been sent", vbInformation
    
exit_line:
    '// Release object memory
    Set newMail = Nothing
    Set mailConfiguration = Nothing
    
    Exit Sub
    
errHandle:
    
    MsgBox "Error: " & Err.Description, vbInformation
    
    GoTo exit_line
    
End Sub
 
Sort by date Sort by votes
I assume you have a reference to [tt]Microsoft CDO for Windows 2000 Library[/tt] in your Project

It may help to know which line of code causes the error "The transport failed to connect to the server"

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Thank you for your response. Yes, I do have the Microsoft CDO library in my reference tools.

The line of error is occurring from the "newmail.Send" line. This is what makes me think that I'm missing a step somewhere not relating to this code.
 
Upvote 0 Downvote
This is a Sub that I've been using for years to send e-mails. Hopefully you can adjust it to your needs.

Code: 
Public Sub SendAMessage(strFrom As String, strTo As String, _
    strCC As String, strSubject As String, strTextBody As String, _
    Optional strBcc As String, Optional strAttachDoc As String, _
    Optional blnHighPriority As Boolean = False)
Dim objMessage As CDO.Message[green]
'You may just do
'Dim objMessage As New CDO.Message
'and skip setting it to New later[/green]

On Error GoTo MyErrorHadler

Set objMessage = New CDO.Message

With objMessage
    .From = strFrom
    .To = strTo
    If Len(Trim$(strCC)) > 0 Then
        .CC = strCC
    End If
    If Len(strBcc) > 0 Then
        .BCC = strBcc
    End If[green]
    ''' On behalf of
    '.Sender = "Joe.Wolf@domain.net"[/green]
    
    If blnHighPriority Then
       With .Fields[green]
           ' for Outlook:[/green]
           .Item(cdoImportance) = cdoHigh
           .Item(cdoPriority) = cdoPriorityUrgent
    [green]
           ' for Outlook Express:
           '.Item("urn:schemas:mailheader:X-Priority") = 1
    [/green]
           .Update
       End With
    End If
    
    .Subject = strSubject
    
    If InStr(UCase(strTextBody), "<HTML>") Or InStr(UCase(strTextBody), "</HTML>") Then
        .HTMLBody = strTextBody
    Else
        .TextBody = strTextBody
    End If

    If Len(strAttachDoc) > 0 Then
        .AddAttachment strAttachDoc
    End If
    
    With .Configuration.Fields[green]
        '.Item(CDO.cdoSMTPServer) = "ABCD.XYZ.INT.LAN"[/green]
        .Item(CDO.cdoSMTPServer) = "CCYOU.KKJU.int.lan"
        .Item(CDO.cdoSMTPServerPort) = 25
        .Item(CDO.cdoSendUsingMethod) = CDO.cdoSendUsingPort
        .Item(cdoSMTPConnectionTimeout) = 10
        .Update
    End With
    .Send
End With

Set objMessage = Nothing

Exit Sub
MyErrorHadler:
[green]'Write error into an Error file
[/green]Resume Next

End Sub

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Just a guess here, but instead of:
Code: 
With fields

you may just need:
Code: 
With [blue]newMail.Configuration.Fields[/blue]
    .Item(msConfigURL & "/smtpusessl") = True
    .Item(msConfigURL & "/smtpauthenticate") = 1
      
    .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
    .Item(msConfigURL & "/smtpserverport") = 465
    .Item(msConfigURL & "/sendusing") = 2
       
    .Item(msConfigURL & "/sendusername") = "enter_gmail"
    .Item(msConfigURL & "/sendpassword") = "enter_gmail_App_Password"        
    .Update    
End With
[green]
'newMail.Configuration = mailConfiguration[/green]
newMail.Send
    
MsgBox "E-Mail has been sent", vbInformation

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Thank you for your time Andy, I tried the suggestion above. It still gives me the .send error. Hum, I will keep looking. Thank you.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
270
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
225
Andrzejek
Andrzejek
Moss100
  • Question
Access send email attachments - problem when null or empty
Replies
7
Views
325
Andrzejek
Andrzejek
M
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
325
SoftwareRT
SoftwareRT
Kennelbloke
  • Locked
  • Question
TransferSpreadsheet 3125 Error
Replies
5
Views
586
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top