Trouble Sendig gmail using smtp

marlan

Registered User.
Local time
Today, 10:22
Joined
Jan 19, 2010
Messages
415
Hi,
An App I have sends G-mail messages using the code below. It works fine on 2 computers I have running WinXP and Acc2003 the one, and Win7 and Acc2010 the other.
A it fails for a client running Acc2013 on Win7. This client uses gmail through outlook, using port 587, and I had an expert look at it, it seem it's not a fire Wall issue.

Any ideas what could go wrong?
Code:
Public Function SendEmailViaGmail(SendTo As String, Optional Subject As String = "", Optional TextBody As String = "", Optional ReplyTo As String = "", Optional AttachedFiles As Variant = "") As String
On Error GoTo send_emailErr
    Dim ErrNum As Long
    Dim ErrDes As String
    SendEmailViaGmail = ""
    ErrNum = 0
    Set cdomsg = CreateObject("CDO.message")
    With cdomsg.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2   'NTLM method
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        If IsNull(SelectdEmailID) Or SelectdEmailID < 1 Then SetDefaultEmailAccount
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendusername '
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendpassword
        .Update
    End With
    ' build email parts
    With cdomsg
        .To = SendTo
        .FROM = sendusername 'IIf(ReplyTo = "", sendusername, ReplyTo)
        .Subject = Subject
        .TextBody = TextBody & vbCrLf & vbCrLf & vbCrLf & "--" & vbCrLf & "Sent via Marlan Data-Systems"
        If IsArray(AttachedFiles) Then
            For Each AttachedFile In AttachedFiles
                If Len(AttachedFile) > 3 Then .AddAttachment AttachedFile
            Next
        Else
            If Len(AttachedFiles) > 3 Then .AddAttachment AttachedFiles
        End If
        .send
    End With
    SendEmailViaGmail = "Done!"
send_emailExit:
    Set cdomsg = Nothing
    Exit Function
    
send_emailErr:
    ErrNum = Err.Number
    ErrDes = Err.Description
    Select Case Err.Number

    Case -2147220977  'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
        SendEmailViaGmail = "Please Format the Email Address Correctly."

    Case -2147220980  'Likely cause, No Recipient Provided (No Email Address)
        SendEmailViaGmail = "Please Provide an Email Address"

    Case -2147220960 'Likely cause, SendUsing Configuration Error
    SendEmailViaGmail = "SendUsing Configuration Error"
    
    Case -2147220973  'Likely cause, No Internet Connection
        SendEmailViaGmail = "Please Check Internet Connection"
    
    Case -2147220975  'Likely cause, Incorrect Password
        SendEmailViaGmail = "Please Check Password"
    
    Case Else   'Report Other Errors
        SendEmailViaGmail = ""
    End Select
    SendEmailViaGmail = SendEmailViaGmail & " Error number: " & Err.Number & " Description: " & Err.Description
    'If ErrNum = -2147220975 Then
    '    cdomsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
    '    Resume
    'End If
    Resume send_emailExit
End Function

I will focus my question:
Is there something in Office 2013 or Access 2013 that would prevent the above code from connecting to the server? (I havn't got the exact error code, but that was the error)

Thanks In Advance!
 
Last edited:

Users who are viewing this thread

Back
Top Bottom