Home » excel » VBA Excel-Sending mail from Excel

VBA Excel-Sending mail from Excel

Posted by: admin April 23, 2020 Leave a comment

Questions:

i have following lines of code to send mail under command button click event.

Private Sub CommandButton1_Click()
Dim cdoConfig
Dim msgOne

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServerPort) = 557  
    .Item(cdoSMTPServer) = "smtp.emailsr.com" 'SMTP server goes here
    '.Item(cdoSendUserName) = "My Username"
    '.Item(cdoSendPassword) = "myPassword"
    .Update
End With

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = "[email protected]"
msgOne.from = "[email protected]"
msgOne.Subject = "Test CDO"
msgOne.TextBody = "It works just fine."
msgOne.Send
End Sub

When i execute this i am facing an error like RunTime Error-2147220977(8004020f): Automation Error The event class for this subscription is in an invalid partition

msgOne.Send

The above line is giving the error during execution.
So i moved on to CDO approach for sending an email.Now i am executing following code.

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
    Dim Flds As Variant

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

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mysmtpserver.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mymailId"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Mypassword"
        .Update

    End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
          "This is line 1" & vbNewLine & _
          "This is line 2" & vbNewLine & _
          "This is line 3" & vbNewLine & _
          "This is line 4"

With iMsg
    Set .Configuration = iConf
    .To = "tomailid"
    .CC = ""
    .BCC = ""
    .From = "mymailid"
    .Subject = "New"
    .TextBody = strbody
    .Send
End With

But Send is giving me an error like Run-time error -2147220977(8004020f): The server rejected one or more recipient addresses. The server response was: 554 5.7.1 : Sender address rejected: Access denied And some times it is like Runtime Error-‘2147220975(80040211)Automation error

How to&Answers:

The code you are using would work in VBScript or other similar languages if you registered the CDO Type Library. The type library contains the properties cdoSendUsingMethod etc so that you don’t have to use the full urn. In VBA, you have to use the full urn. Ron De Bruin has a good reference about this at http://www.rondebruin.nl/cdo.htm.

From his site you can see the difference between your code and that required for VBA, specifically here:

     Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                           = "Fill in your SMTP server here"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With