VBA for excel to send multiple emails; subject; body (Content)

[harky]

[TABLE="width: 500"]
<tbody>[TR]
[TD]To[/TD]
[TD]Subject[/TD]
[TD]Content[/TD]
[/TR]
[TR]
[TD]abc@email.com; 123@email.com[/TD]
[TD]ABC - 1[/TD]
[TD]Content 1[/TD]
[/TR]
[TR]
[TD]abc@email.com; 123@email.com[/TD]
[TD]ABC - 2[/TD]
[TD]Content 2[/TD]
[/TR]
</tbody>[/TABLE]

Hi, i found this code but it only work for email but not suject & content

Sub SendEm()
Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set Mail_Object = CreateObject("Outlook.Application")
For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .Subject = Range("B2").Value
            .To = Range("A" & i).Value
            .Body = Range("C2").Value
            '.Send
            .display 'disable display and enable send to send automatically
    End With
Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub

 

[harky]

Oh my. I manage to fix it. Thx guy

Change the code as below

Sub SendEmail()
Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set Mail_Object = CreateObject("Outlook.Application")
For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .Subject = Range("B" & i).Value
            .To = Range("A" & i).Value
            .Body = Range("C" & i).Value
            .CC = Range("D" & i).Value
            '.Send
            .display 'disable display and enable send to send automatically
    End With
Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub

 

[KOKOSEK]

            .Subject = Range("B" & i).Value
            .To = Range("A" & i).Value
            .Body = Range("C" & i).Value

 

[harky]

Thanks!

Sub SendEm()
Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
Dim wks As Worksheet


lr = Cells(Rows.Count, "B").End(xlUp).Row


Set Mail_Object = CreateObject("Outlook.Application")
Set wks = Worksheets("Sheet2")


For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .Subject = wks.Range("C" & i).Value
            .To = wks.Range("B" & i).Value
            .Body = wks.Range("D" & i).Value
            .CC = wks.Range("E" & i).Value
            '.Send
            .display 'disable display and enable send to send automatically
            Application.Wait (Now + TimeValue("0:00:05")) 'Pausing an application for 5s, before next email
    End With
Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub

            .Subject = Range("B" & i).Value
            .To = Range("A" & i).Value
            .Body = Range("C" & i).Value