.NET Tutorials, Forums, Interview Questions And Answers
Welcome :Guest
Sign In
Win Surprise Gifts!!!

Top 5 Contributors of the Month
Melody Anderson

Home >> Articles >> Vb Script >> Post New Resource Bookmark and Share   

 Subscribe to Articles

Sending Emails with attachment and Embedded Image from Excel

Posted By:Kemal AL GAZZAH       Posted Date: February 19, 2014    Points: 200    Category: Vb Script    URL: http://www.dotnetspark.com  

This code allow to send Emails from an Excel sheet

The following code allow to send Emails using VBA in EXCEL
You can add file attachment as well as an embedded Image which will be displayed in the Body message itself

The Email destinators are stored in sheet1 Columns E and there is a loop which goes through this Columns and sends teh Email to each destinator one by one.

The following fields <Subject, Body, to,cc,bcc> are filled by the user in sheet1 (or feuil1 in French)
The Mail parameters (SMTPSERVER, SMTP PORT NUMBER ETC) are stored in sheet2

1) first open a new Excel sheet , go to Tools, macros, VB editor 
2) Tools-References-add => Microsoft CDO
add the following function
Sub CDO_Mail(strbody, ito, icc, ibcc, ifrom, isubject)
On Error GoTo fin:
    Dim iMsg As Object
    Dim BP As Object
    Dim iConf As Object
    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") = Feuil2.Cells(2, 2)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Feuil2.Cells(3, 2)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Feuil2.Cells(4, 2)
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Feuil2.Cells(5, 2)
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Feuil2.Cells(6, 2)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Feuil2.Cells(7, 2) '465 pour gmail
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "False" ' True pour gmail.com
        End With
    Dim CdoReferenceTypeName As Integer
    CdoReferenceTypeName = 1
    Set objBP = iMsg.AddRelatedBodyPart(Feuil1.Cells(7, 2), "myimage.gif", CdoReferenceTypeName)
    objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.gif>"
    With iMsg
        Set .Configuration = iConf
        .To = ito
        .CC = icc
        .BCC = ibcc
        .From = ifrom
        .Subject = isubject
        .HTMLBody = strbody
        .AddAttachment Feuil1.Cells(6, 2) '"c:\test.txt"
    End With
    Exit Sub
'MsgBox ("Erreur lors de l'envoi du Mail à: " & ito)
Resume Next

End Sub
Then add the following sub

Sub send_all()
Dim strbody As String

'Lecture du body de l'email
strbody = "<html><body>"
For l = 8 To 24
    strbody = strbody & Feuil1.Cells(l, 2) & "<br>"
strbody = strbody & "<hr><img src=""cid:myimage.gif""></body></html>"

'Envoi à la liste feuil1.cells(1,5) > cellule E1=> liste des emails destinataires
l = 1
If Feuil1.Cells(l, 5) <> "" And InStr(1, Feuil1.Cells(l, 5), "@") <> 0 Then
Call CDO_Mail(strbody, Feuil1.Cells(l, 5), Feuil1.Cells(3, 2), Feuil1.Cells(4, 2), Feuil1.Cells(2, 2), Feuil1.Cells(5, 2))
End If
l = l + 1
Loop Until Feuil1.Cells(l, 5) = ""
MsgBox ("Envoi Complet")
End Sub

 Subscribe to Articles


Further Readings:


No response found. Be the first to respond this post

Post Comment

You must Sign In To post reply
Find More Articles on C#, ASP.Net, Vb.Net, SQL Server and more Here

Hall of Fame    Twitter   Terms of Service    Privacy Policy    Contact Us    Archives   Tell A Friend