Hello to All,
I'm trying to find a setting for emailing in cdo that will display custom text in the recievers inbox "From" column.
So far everything I tried didn't help, in the From column the receiver sees my gmail address minus @gmail.com.
This is the code I'm using:
I'm trying to find a setting for emailing in cdo that will display custom text in the recievers inbox "From" column.
So far everything I tried didn't help, in the From column the receiver sees my gmail address minus @gmail.com.
This is the code I'm using:
Code:
Private Const URL_CDOCONFIG As String = "[URL]http://schemas.microsoft.com/cdo/configuration/[/URL]"
Public Function SendEmail(ByVal sTo As String, _
ByVal sFrom As String, _
Optional ByVal sCC As String = "", _
Optional ByVal sBCC As String = "", _
Optional ByVal sSubject As String = "", _
Optional ByVal sBody As String = "", _
Optional ByVal sServer As String = "smtp.gmail.com", _
Optional ByVal iPort As Integer = 587, _
Optional ByVal sUsername As String = "MyEmail@gmail.com", _
Optional ByVal sPassword As String = "MyPassword", _
Optional ByVal iSendUsing As Integer = 2, _
Optional ByVal bAuthenticate As Boolean = True, _
Optional ByVal bUseSSL As Boolean = True, _
Optional ByVal iTimeout As Integer = 10, _
Optional ByVal sAttachment As String) _
As Boolean
On Error Resume Next
Err.Clear
Dim cdoMsg As CDO.Message
Set cdoMsg = CreateObject("CDO.message")
If Err Then
Debug.Print Err.Description
SendEmail = False
Else
With cdoMsg
With .Configuration.Fields
.Item(URL_CDOCONFIG & "sendusing") = iSendUsing
.Item(URL_CDOCONFIG & "smtpserver") = sServer
.Item(URL_CDOCONFIG & "smptserverport") = iPort
.Item(URL_CDOCONFIG & "smtpauthenticate") = IIf(bAuthenticate, 1, 0)
.Item(URL_CDOCONFIG & "smtpusessl") = bUseSSL
.Item(URL_CDOCONFIG & "smtpconnectiontimeout") = iTimeout
.Item(URL_CDOCONFIG & "sendusername") = sUsername
.Item(URL_CDOCONFIG & "sendpassword") = sPassword
.Update
End With
.To = sTo
.From = "Me" 'sFrom
.CC = sCC
.BCC = sBCC
.Sender = "Me"
.Subject = sSubject
.TextBody = sBody
If Len(sAttachment) > 0 Then
.AddAttachment sAttachment
End If
If Err Then
Debug.Print Err.Description
SendEmail = False
Else
DoCmd.Hourglass True
.send
DoCmd.Hourglass False
If Err Then
Debug.Print Err.Description
SendEmail = False
Else
SendEmail = True
End If
End If
End With
Set cdoMsg = Nothing
End If
End Function