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


Top 5 Contributors of the Month
david stephan

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
            .Update
        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>"
    objBP.Fields.Update
    
    
    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"
        .Send
    End With
    Exit Sub
fin:
'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>"
Next
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
Do
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:

Responses

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