Public Function gMailCDO(ByVal gmailUsername As String, ByVal
gmailPassword As String, ByRef eMessage As String, ByRef RecptAddr As
String, Optional ByRef eSubject As String, Optional ByRef CC As String,
Optional ByRef BCC As String, Optional ByRef AttachmentFullPath As
String, Optional ByRef smtpServer As String, Optional ByRef smtpPort As
Integer)
Dim eMail As Object
Dim eConfig As Object
Dim Flds As Variant
Set eMail = CreateObject("CDO.Message")
Set eConfig = CreateObject("CDO.Configuration")
If smtpServer = "" Then
smtpServer = "smtp.gmail.com"
End If
If Not smtpPort Then
smtpPort = 465
End If
eConfig.Load -1
Set Flds = eConfig.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = gmailUsername
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = gmailPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpPort
.Update
End With
With eMail
Set .configuration = eConfig
.To = RecptAddr
.CC = CC
.BCC = BCC
.From = RecptAddr
.Subject = eSubject
.TextBody = eMessage
If AttachmentFullPath <> "" Then
.AddAttachment AttachmentFullPath
End If
End With
End Function
No comments:
Post a Comment