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?
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!
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: