CDO Email

[CharlesWhiteman]

I'm using the following code to send automated emails from my Db but am having problems.

Can I use this code to send through a network with exchange server? Or configure the code to use the Exchange server or should the SMTP transport still work.

'Email Notify
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 objmessage = CreateObject("CDO.Message")
Dim strUserName As String
strUserName = Forms.FrmSplashScreen.txtCurrentUser
Dim strEmailTo As String
strEmailTo = DLookup("MailEmailAddress", "TblUsers", "UserID =" & Me.txtTaskWorker)
Dim strReplyAddress As String
strReplyAddress = DLookup("MailEmailAddress", "TblUsers", "WindowsName = Forms.FrmSplashScreen.txtWindowsName")
'Dim strSignature As String
'strSignature = DLookup("GlobalSignature", "TblVariablesSystem")
objmessage.Subject = "Omniscient Task Notification"
objmessage.FROM = DLookup("MailEmailAddress", "TblUsers", "WindowsName = Forms.FrmSplashScreen.txtWindowsName")
objmessage.To = DLookup("MailEmailAddress", "TblUsers", "UserID =" & Me.txtTaskWorker)
objmessage.TextBody = "This is an automated message from Omniscient" & vbCrLf & vbCrLf & "Here are the details:" & vbCrLf & vbCrLf & "A default alert task has been set against job Number: " & Me.txtJobNumber & " the task is due for completion on " & Me.txtTaskDueDate
'==This section obtains user variables from TblDbUsers & the message text.
Dim strSMTPserver As String
strSMTPserver = DLookup("MailGateway", "TblVariablesSystem")

Dim strUserID As String
strUserID = DLookup("MailUserName", "TblUsers", "WindowsName = Forms!FrmSplashscreen!txtWindowsName")

Dim strUserPassword As String
strUserPassword = DLookup("MailPassword", "TblUsers", "WindowsName = Forms!FrmSplashscreen!txtWindowsName")

'==This section provides the configuration information for the remote SMTP server.
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
'Name or IP of Remote SMTP Server
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = strSMTPserver
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpauthenticate[/URL]") = cdoBasic
'Your UserID on the SMTP server
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusername[/URL]") = strUserID
'Your password on the SMTP server
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendpassword[/URL]") = strUserPassword
'Server port (typically 25)
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
'Use SSL for the connection (False or True)
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpusessl[/URL]") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objmessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout[/URL]") = 60
objmessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
'obj.AddAttachment = ("C:\test.txt")
objmessage.send

 

[pbaldy]

This works with Exchange Server (10.2.0.121 is the internal address of the Exchange server):

Public Function SendUsingCDO()
    Dim iCfg As Object
    Dim iMsg As Object

    On Error GoTo ErrorHandler

    DoCmd.TransferText ...

    Set iCfg = CreateObject("CDO.Configuration")
    Set iMsg = CreateObject("CDO.Message")

    With iCfg.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.2.0.121"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = "PaulB <paulb@whatever.com>"
        .Update
    End With

    With iMsg
        .Configuration = iCfg
        .Subject = "subject"
        .To = "destination@whoever.com"
        .TextBody = "body here"
        .AddAttachment "C:\whatever.csv"
        .Send
    End With

ExitHandler:
    Set iMsg = Nothing
    Set iCfg = Nothing
    Exit Function

ErrorHandler:
    Select Case Err
    Case Else
        MsgBox Err.Description & " in SendUsingCDO "
        DoCmd.Hourglass False
        Resume ExitHandler
    End Select
End Function

 

[CharlesWhiteman]

any thanks for posting back. I'm afriad with workload have only just got around to looking.

Presumably, the username and password is the same as in active directory?

 

[pbaldy]

Yes, same as AD.