Excel VBA for E-Mailing



I have tried VBA codes for sending E-Mail through using excel.

I'm not able to complete this.

Can anyone please try to solve my querries.

The querries are

1. I need to select the recipient address is a cell value and the same "CC" and "BCC" also.

2. Subject content also a cell value.

I have uploaded the codes kindly check the highlited the same.





Please don't forget to select the answer that worked best for you! Just click the Select Answer button at the bottom of the desired answer.
don (rep: 1247) Jul 13, '17 at 2:49 pm
Add to Discussion



Here is what I use in many of my automated workbooks and it works nicely.

Sub Mail_Workbook(strTo As String, strSubject As String, strBody As String, Optional strAttach As String, _
                    Optional strCC As String, Optional strBCC As String, Optional boolDisp As Boolean = False)
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim SigString As String
    Dim Signature As String
    Dim i As Integer
    Dim vArray As Variant
   'Use the second SigString if you use Vista or win 7 as operating system

    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\Default.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
        Signature = ""
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTo
        .cc = strCC
        .BCC = strBCC
        .Subject = strSubject
        .HTMLBody = strBody & vbCrLf & Signature
vArray = Split(strAttach, ",")

If Len(strAttach) > 0 Then
    For i = 0 To UBound(vArray, 1)

'        If i = UBound(vArray, 1) Then
'            .attachments.Add vArray(i)
'            Exit For
'        Else
            .Attachments.Add vArray(i)
'        End If

    Next i
End If

        If boolDisp = True Then
        End If

    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
End Function

The variables can either be passed explicitly by tyyping them into the call statement.  Or, I use variables pointing to cells in my workbookbook that looks like this

intA = ThisWorkbook.Worksheets("Start").Cells(Rows.Count, 1).End(xlUp).row
intB = ThisWorkbook.Worksheets("Start").Cells(Rows.Count, 2).End(xlUp).row

For Each varCell In ThisWorkbook.Worksheets("Start").Range("A1:A" & intA)
    strTo = strTo & varCell & ";"
Next varCell

For Each varCell In ThisWorkbook.Worksheets("Start").Range("B1:B" & intB)
    strCC = strCC & varCell & ";"
Next varCell

The nice thing about the above way is that you can change the To recipients and CC recipients just by altering the cells referenced.


 Hi Karthik,

Use below code


Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cel As Range
Dim lastRow As Long
Dim Rng As Range
Set OutApp = CreateObject("Outlook.Application")
lastRow = Sheets("Sheet1").Range("A:A").Find("*", Range("A1"), Searchdirection:=xlPrevious).Row
Set Rng = Sheets("Sheet1").Range(Cells(2, "A"), Cells(lastRow, "A"))
For Each cel In Rng
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = cel.Value
        .CC = cel.Offset(0, 1).Value
        .BCC = cel.Offset(0, 2).Value
        .Subject = cel.Offset(0, 3).Value
        .Body = cel.Offset(0, 4).Value
        '.Attachments.Add cel.Offset(0, 5).Value
    End With
Next cel
Set OutMail = Nothing
Set OutApp = Nothing
End Sub




Post Edited
CODE Tags: You must add [CODE][/CODE] tags around your code! (click the CODE button to do this when creating a post)


Please put CODE tags around your code. To do that, edit your post, select your code and click the CODE button.
don (rep: 1247) Jun 28, '17 at 9:24 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login