VBA SMTP Sending Outlook mail has no errors, but nothing being sent.

[countryfan_nt]

Hello friends, Hope all is well!

I am confused, there is nothing wrong with the code below (at least to my humble knowledge).
when the code reaches the line .Send, it pauses for say 15-20 seconds, and the code resumes, but nothing sent on outlook.

I used the same code in my previous organization and it was working. and there are no bugs.

Your kind help please!
Thank you for your continuous support

Sub Send_Email(ByVal mailTo As String, _
                ByVal mailCC As String, _
                ByVal mailBCC As String, _
                ByVal mailSubject As String, _
                ByVal mailBody As String, _
                ByVal mailAttachment As String)
                      
    Dim CDO_Mail_Object As Object
    Dim CDO_Config As Object
    Dim SMTP_Config As Variant
    
    On Error GoTo debugs
    
    Set CDO_Mail_Object = CreateObject("CDO.Message")
    Set CDO_Config = CreateObject("CDO.Configuration")
    CDO_Config.Load -1
    Set SMTP_Config = CDO_Config.Fields
    
    With SMTP_Config
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'please put your server name below
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "health.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    
    With CDO_Mail_Object
        Set .Configuration = CDO_Config
        
        .From = GetUserID & "@health.com"
        .To = mailTo
        .CC = mailCC
        .BCC = mailBCC
        .Subject = mailSubject
        .TextBody = mailBody
        If mailAttachment <> "" Then .AddAttachment mailAttachment
        .Send
    End With
    
Exit Sub
debugs:
    'If Err.Description <> "" Then MsgBox Err.Description
End Sub

 

[Micron]

Been a long time since I've done that.

I used the same code in my previous organization and it was working

That suggests your configuration details have changed. I figured out what I needed by sending myself an email and looking at the headers for the server name & port. That might help you even if in your situation the recipient is not on the same server since the sending server is what you need to work with.

 

[6StringJazzer]

When you use CDO to send email, you are communicating directly with an SMTP server, bypassing Outlook. Outlook has no idea you are doing this.

If you need to manage emails in Outlook then you need a completely different approach, using Outlook to do this. Here is the equivalent of your code to do this in Outlook.

Option Explicit

' Item types
Public Const olAppointmentItem = 1
Public Const olContactItem = 2
Public Const olDistributionListItem = 7
Public Const olJournalItem = 4
Public Const olMailItem = 0
Public Const olNoteItem = 5
Public Const olPostItem = 6
Public Const olTaskItem = 3

Public Const olMeeting = 1

Public Const olRequired = 1

Public Const olResource = 3

Public Const olTo = 1
Public Const olCC = 2
Public Const olBCC = 3

Public Const olimportancenormal = 1

Public Const olbyvalue = 1


' Classes
Public Const olMail = 43
Public Const olMeetingRequest = 53

' Late Binding, no references required
' Use recipient Subs to add To and cc recipients
Public Sub SendEMail(MailTo As String, MailCC As String, MailBCC As String, Subject As String, Body As String, Optional AttachmentPath As String = "", Optional DisplayOnly As Boolean = True)


   Dim olMail As Object ' MailItem
   Dim OutlookApp As Object
   Dim ToRecipient As Object ' Recipient
   Dim CCRecipient As Object ' Recipient
   Dim BCCRecipient As Object ' Recipient
   
   Set OutlookApp = GetObject(, "Outlook.Application")
    
   Set olMail = OutlookApp.CreateItem(olMailItem)
    
   With olMail
       .Subject = Subject
       .Importance = olimportancenormal
       If AttachmentPath <> "" Then
         .Attachments.Add AttachmentPath, olbyvalue
       End If
       .Body = Body
   End With
      
   Set CCRecipient = olMail.Recipients.Add(MailCC)
   
   CCRecipient.Type = olCC
   CCRecipient.Resolve
   
   
   Set ToRecipient = olMail.Recipients.Add(MailTo)
   
   ToRecipient.Type = olTo
   ToRecipient.Resolve

   Set BCCRecipient = olMail.Recipients.Add(MailBCC)
   
   BCCRecipient.Type = olBCC
   BCCRecipient.Resolve
   
   If DisplayOnly Then
      olMail.display
   Else
      olMail.Send
   End If
    
End Sub

 

[6StringJazzer]

I believe that using CDO to send through a Microsoft Exchange server instead of SMTP will cause the traffic to be replicated in Outlook, but I don't think that is what your current code is doing. Maybe that's what your configuration in your previous organization did.

 

[countryfan_nt]

When you use CDO to send email, you are communicating directly with an SMTP server, bypassing Outlook. Outlook has no idea you are doing this.

If you need to manage emails in Outlook then you need a completely different approach, using Outlook to do this. Here is the equivalent of your code to do this in Outlook.

Option Explicit

' Item types
Public Const olAppointmentItem = 1
Public Const olContactItem = 2
Public Const olDistributionListItem = 7
Public Const olJournalItem = 4
Public Const olMailItem = 0
Public Const olNoteItem = 5
Public Const olPostItem = 6
Public Const olTaskItem = 3

Public Const olMeeting = 1

Public Const olRequired = 1

Public Const olResource = 3

Public Const olTo = 1
Public Const olCC = 2
Public Const olBCC = 3

Public Const olimportancenormal = 1

Public Const olbyvalue = 1


' Classes
Public Const olMail = 43
Public Const olMeetingRequest = 53

' Late Binding, no references required
' Use recipient Subs to add To and cc recipients
Public Sub SendEMail(MailTo As String, MailCC As String, MailBCC As String, Subject As String, Body As String, Optional AttachmentPath As String = "", Optional DisplayOnly As Boolean = True)


   Dim olMail As Object ' MailItem
   Dim OutlookApp As Object
   Dim ToRecipient As Object ' Recipient
   Dim CCRecipient As Object ' Recipient
   Dim BCCRecipient As Object ' Recipient
  
   Set OutlookApp = GetObject(, "Outlook.Application")
   
   Set olMail = OutlookApp.CreateItem(olMailItem)
   
   With olMail
       .Subject = Subject
       .Importance = olimportancenormal
       If AttachmentPath <> "" Then
         .Attachments.Add AttachmentPath, olbyvalue
       End If
       .Body = Body
   End With
     
   Set CCRecipient = olMail.Recipients.Add(MailCC)
  
   CCRecipient.Type = olCC
   CCRecipient.Resolve
  
  
   Set ToRecipient = olMail.Recipients.Add(MailTo)
  
   ToRecipient.Type = olTo
   ToRecipient.Resolve

   Set BCCRecipient = olMail.Recipients.Add(MailBCC)
  
   BCCRecipient.Type = olBCC
   BCCRecipient.Resolve
  
   If DisplayOnly Then
      olMail.display
   Else
      olMail.Send
   End If
   
End Sub

Very cool ! thank you very much

trying to call the code you provided, got "Compile Error: Argument Not Optional".
I call the code from a "Private Sub Workbook_Open()" code.

thank you again for your kind feedback

 

[6StringJazzer]

What line of code caused the error? It compiled and ran successfully for me.

 

[countryfan_nt]

there is no error, however on the line .Send, the code freezes for 15-20 seconds, then resumes with no action.

 

[6StringJazzer]

got "Compile Error: Argument Not Optional".

there is no error,

Did you get a compile error? Or not?

 

[countryfan_nt]

Did you get a compile error? Or not?

No nothing, no errors, I wonder perhaps the SMTP is disabled by the IT of my organization?

 

[6StringJazzer]

In the code that calls it, try specifying DisplayOnly:=True to see if it generates the email at all.