Help with sending emails from Exchange using CDO in VBA

[ashwah]

Hi All,

I have been tasked with making an application in Access/VBA which can send emails. I am playing with some code that uses CDO to create and send the message via the server in the office which is running SBS 2008. What I have done so far worked ok with messages on my own domain but failed with the following error message if I attempted to mail an external address:

“The server rejected one or more recipient addresses. The server response was: 550 5.7.1 Unable to relay”

I got past this problem by following some other forum advice and created a ‘Receive Connecter’ in Exchange (not sure if this is correct). Either way this didn’t work but generated a new error:

“The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available”

This is where I am stuck as I can’t find any useful info on this second error. Please help! Oh and bear in mind I have only modest VBA knowledge, and am rubbish with Exchange! Here’s my code:

Private Sub cmdGo_Click()

    Dim iMsg As Object
    Dim iConf As Object
    Dim strBody As String

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

    iConf.Load -1    
    Set Flds = iConf.Fields
    
    With Flds
        
        .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") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.**.**"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
        
    End With

    strBody = "...html email body."
    
    
    With iMsg

        Set .Configuration = iConf
        .To = "me@external.com"
        .Sender = "me@mydomain.com"
        .Subject = "Email Is Awesome"
        .HTMLBody = strBodyMerged
        .Send

    End With
    
    
End Sub

[ADezii]

I'll post the Code that I use successfully to direct E-Mail thru a SMTP Server. I ran into a similar problem awhile ago, and it was because the Server needed to be programmed to accept Addressees outside of a certain Domain.

Dim lstrFrom As String
Dim lstrTo As String
Dim lstrSubject As String
Dim lstrBody As String
Dim lstrAttachment As String
Dim lstrServerIPAddr As String

lstrTo = "FredFlintstonel@YaDa.org"
lstrFrom = "AID Security@TCenter.org"
lstrSubject = "Incident Report: " & Now()
lstrBody = "Attached please find Incident Report for your review"
lstrAttachment = "C:\Dell\IR.snp"
lstrServerIPAddr = "10.2.0.32"

Call Mail_SMTP("", "", lstrFrom, lstrTo, lstrSubject, lstrBody, , , lstrAttachment, , lstrServerIPAddr)

MsgBox "Incident Report has been sent to [" & lstrTo & "]", vbExclamation, ""

Public Function Mail_SMTP(strNTUserName As String, strNTUserPwd As String, _
         strFrom As String, strTo As String, Optional strSubject As String, _
         Optional strBody As String, Optional strBCC As String, _
         Optional strCC As String, Optional strAttachment As String, _
         Optional strHTMLBody As String, Optional strMailServer As String = "10.2.0.32")
On Error GoTo ErrHandler
Dim email As New CDO.Message
    
With email
  .From = strFrom
  .To = strTo
    If (Len(strAttachment) > 0) Then .AddAttachment strAttachment
    If (Len(strHTMLBody) > 0) Then .HTMLBody = strHTMLBody                '"<H4>See attached file</H4>"
    If (Len(strBCC) > 0) Then .BCC = strBCC
    If (Len(strCC) > 0) Then .CC = strCC
    If (Len(strSubject) > 0) Then .Subject = strSubject
    If (Len(strBody) > 0) Then .TextBody = strBody
        
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  
   'Name or IP of Remote SMTP Server
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
  
   'Type of authentication, NONE, Basic (Base64 encoded), NTLM
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 0
  
   'Your UserID on the SMTP server
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strNTUserName
  
   'Your password on the SMTP server
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strNTUserPwd
  
   'Server port (typically 25)
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  
   'Use SSL for the connection (False or True)
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
  
   'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
  .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Configuration.Fields.Update
      .Send
End With
        
ExitProcedure:
  Exit Function

ErrHandler:
  Err.Raise Err.Number, "Mail_SMTP", "An the following error occurred while attempting " & _
                        "to send mail via Mail_SMTP." & vbCrLf & "Error Number: " & Err.Number & _
                        vbCrLf & vbCrLf & "Error Description: " & vbCrLf & Err.Description
  Resume ExitProcedure
End Function

[ashwah]

Thanks ADezii, much appreciated. Don't have time to test this now as it's late on Friday but will play around with it next week. :)

[ashwah]

Ah a new week, and seem to have made this work!

Played about with authentication and permission group settings. Started getting a different error message:

"The server rejected the sender address server response was 550 5.7.1 client does not have permission to send as this sender"

So I chose a different sender address which had send-as permissions set.

Thanks