Sender Property CDO

moishy

Registered User.
Local time
Today, 03:37
Joined
Dec 14, 2009
Messages
264
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:
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
 

Users who are viewing this thread

Back
Top Bottom