[Solved] Bulk Email Using VBA and Signature

[sharad_2307]

HI Friends,

I have to create excel file to send bulk email using outlook, my file running well with VBA code, but when i run the file using this VBA default signature not added in outlook while sending email. help me on that.
Thanks in advance for help..

Regards,

 

[Lutfor Rahman Shimanto]

HI Friends,

I have to create excel file to send bulk email using outlook, my file running well with VBA code, but when i run the file using this VBA default signature not added in outlook while sending email. help me on that.
Thanks in advance for help..

Regards,

Hello Sharad

Thanks for reaching out and sharing your problem. I have reviewed your situation and come up with a tricky idea. All you need to do is display the emails before adding the HTML body and sending them.

Don't worry! I have improved the existing code to fulfil your goal. So, please keep the following code in a module and assign it to the button.

Excel VBA Sub-procedure:

Sub Send_Mails()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Dim i As Integer
    Dim sign As String
    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("Outlook.Application")

    Dim last_row As Integer
    last_row = Application.CountA(sh.Range("A:A"))

    For i = 2 To last_row
        Set msg = OA.CreateItem(0)
        msg.Display
        msg.To = sh.Range("A" & i).Value
        msg.cc = sh.Range("B" & i).Value
        msg.Subject = sh.Range("C" & i).Value

        Dim signature As String
        signature = msg.HTMLBody

        msg.HTMLBody = sh.Range("D" & i).Value & "<br><br>" & signature

        If sh.Range("E" & i).Value <> "" Then
            msg.attachments.Add sh.Range("E" & i).Value
        End If

        msg.send

        sh.Range("F" & i).Value = "Sent"
    Next i

    MsgBox "All the mails have been sent successfully"

End Sub

Hopefully, you have found the solution you were looking for. I have attached the solution workbook as well. Good luck.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy

 

[sharad_2307]

Thanks for the help , but i have to ad one more dynamics which i forget to tell beore i have to add multiple attachment in email. can you add this code in current sheet

Thanks
Sharad

 

[Lutfor Rahman Shimanto]

Thanks for the help , but i have to ad one more dynamics which i forget to tell beore i have to add multiple attachment in email. can you add this code in current sheet

Thanks
Sharad

Dear Sharad

Thanks for your nice words. Your appreciation means a lot to us.

I have reviewed your requirements and improved the previously given Excel VBA Sub-procedure. All you need to do is to keep the attachment addresses by putting a comma within these attachments, like the following image:

​

Excel VBA Sub-procedure:

Sub Send_Mails()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    Dim i As Long
    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("Outlook.Application")

    Dim last_row As Long
    last_row = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row

    For i = 2 To last_row
        Set msg = OA.CreateItem(0)
        msg.Display
        msg.To = sh.Range("A" & i).Value
        msg.CC = sh.Range("B" & i).Value
        msg.Subject = sh.Range("C" & i).Value

        Dim signature As String
        signature = msg.HTMLBody

        msg.HTMLBody = sh.Range("D" & i).Value & "<br><br>" & signature

        Dim attachments As Variant
        Dim j As Integer
        attachments = Split(sh.Range("E" & i).Value, ",")

        On Error Resume Next
        For j = LBound(attachments) To UBound(attachments)
            If Trim(attachments(j)) <> "" Then

                Dim attachmentPath As String
                attachmentPath = Replace(Trim(attachments(j)), """", "")
               
                If Dir(attachmentPath) <> "" Then
                    msg.attachments.Add attachmentPath
                Else
                    MsgBox "Attachment file not found: " & attachmentPath, vbExclamation
                End If
            End If
        Next j
        On Error GoTo 0

        msg.Send

        sh.Range("F" & i).Value = "Sent"
    Next i

    MsgBox "All the mails have been sent successfully"

End Sub

After running the sub-procedure or clicking on the button, you will get an output like the following:

​

Hopefully, you have found the solution you were looking for. I have attached the solution workbook for better understanding.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy