I have browsed a number of posts on this topic but for some strange and very subtle reason, my code is refusing to work.
Can anyone find the cause for the following Err on the .Update
Err : 3749 : Object/ErrObject : AbundanceUtilities.SendByGmail
: Description : "Fields update failed. For further information, examine the Status property of individual field objects." : String : AbundanceUtilities.SendByGmail
: HelpContext : 1240791 : Long : AbundanceUtilities.SendByGmail
: HelpFile : "C:\Windows\HELP\ADO270.CHM" : String : AbundanceUtilities.SendByGmail
: LastDllError : 0 : Long : AbundanceUtilities.SendByGmail
: Number : 3749 : Long : AbundanceUtilities.SendByGmail
: Source : "ADODB.Fields" : String : AbundanceUtilities.SendByGmail
My code is as follows:
Function SendByGmail(sFilename) As String
On Error GoTo MyErrorHandler:
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
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/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "******"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "******"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 465 'alternative port 2, Direct SSL 465, 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update 'Fails to update!!!
End With
strbody = "test"
With iMsg
Set .Configuration = iConf
.To = "[email protected]"
.CC = ""
.BCC = ""
' Note: The reply address does not work if you use this Gmail example
'.ReplyTo = "[email protected]"
.From = "[email protected]"
.Subject = "Test Message"
.TextBody = strbody
.AddAttachment sFilename
.Send
End With
SendByGmail = "1"
MyErrorHandler:
SendByGmail = "0"
Err.Clear
End Function
Any help would be appreciated.
Virat
Bookmarks