Saturday, 24 November 2012

3 different ways of sending email from Excel.

Here, I have 3 different ways of sending email from Excel.

Add the following code at the top of the module


Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Then use one of the following codes depending on which one suits the purpose.

'Send via Microsoft Outlook


Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

Email_Subject = "Trying to send email using VBA"

Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"

On Error GoTo debugs

Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
End With

debugs:

If Err.Description <> "" Then MsgBox Err.Description
End Sub

'Send using CDO

Sub Send_Email_Using_CDO()
Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

Email_Subject = "Trying to send email using CDO"

Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using CDO !!!!"

Set CDO_Mail_Object = CreateObject("CDO.Message")


On Error GoTo debugs

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
            'Put your server name below
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOURSERVERNAME"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
        
With CDO_Mail_Object
    Set .Configuration = CDO_Config
End With

CDO_Mail_Object.Subject = Email_Subject

CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = Email_Send_To
CDO_Mail_Object.TextBody = Email_Body
CDO_Mail_Object.cc = Email_Cc                      'Use if needed
CDO_Mail_Object.BCC = Email_Bcc                    'Use if needed
'CDO_Mail_Object.AddAttachment FileToAttach        'Use if needed
CDO_Mail_Object.send

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

'Send using SendKeys
'CODE COURTESY :: WWW.OZGRID.COM
Sub Send_Email_Using_Keys()
    Dim Mail_Object As String
    Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
    
    Email_Subject = "Trying to send email using Keys"
    Email_Send_To = "databison@gmail.com"
    Email_Cc = "databison@gmail.com"
    Email_Bcc = "databison@gmail.com"
    Email_Body = "Congratulations!!!! You have successfully sent an e-mail using Keys !!!!"
               
    Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject & "&body=" & Email_Body & "&cc=" & Email_Cc & "&bcc=" & Email_Bcc

    On Error GoTo debugs

    ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString, vbNormalFocus

    Application.Wait (Now + TimeValue("0:00:02"))

    Application.SendKeys "%s"

debugs:

If Err.Description <> "" Then MsgBox Err.Description
End Sub

No comments:

Post a Comment