• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to send mail based on cell values

Hi,

Can anyone help me with creating a macro that will send seperate email for each row with data
  • from outlook app to email id mentioned in column B
  • Subject will be in column C
  • text will be "Dear " & value in coulmn A
    • rest data taken from column D,E,F,G each on seperate line
 

Attachments

  • Book1.xlsx
    9.5 KB · Views: 3
Hi,

Can anyone help me with creating a macro that will send seperate email for each row with data
  • from outlook app to email id mentioned in column B
  • Subject will be in column C
  • text will be "Dear " & value in coulmn A
    • rest data taken from column D,E,F,G each on seperate line
Hi,

Something like this should work:
Code:
Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object

    For Each c In Range("A2:A" & Columns("A").Cells(Rows.Count).End(xlUp).Row).Cells

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
     
    With OutLookMailItem
            .To = c.Offset(0, 1).Value
            .Subject = c.Offset(0, 2).Value
            .HTMLbody = "Dear " & c.Value & "<br>" & c.Offset(0, 3).Value & "<br>" & c.Offset(0, 4).Value & "<br>" & c.Offset(0, 5).Value & "<br>" & c.Offset(0, 6).Value
            .Display
'            .Send
    End With
 
    Next c

End Sub

Just comment ".Display" and uncomment ".Send" if you do not wish to see the preview window before sending.

Please refer to the attached file.
Hope this helps
 

Attachments

  • Book1.xlsm
    15.7 KB · Views: 20
Hi,

Something like this should work:
Code:
Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object

    For Each c In Range("A2:A" & Columns("A").Cells(Rows.Count).End(xlUp).Row).Cells

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    
    With OutLookMailItem
            .To = c.Offset(0, 1).Value
            .Subject = c.Offset(0, 2).Value
            .HTMLbody = "Dear " & c.Value & "<br>" & c.Offset(0, 3).Value & "<br>" & c.Offset(0, 4).Value & "<br>" & c.Offset(0, 5).Value & "<br>" & c.Offset(0, 6).Value
            .Display
'            .Send
    End With

    Next c

End Sub

Just comment ".Display" and uncomment ".Send" if you do not wish to see the preview window before sending.

Please refer to the attached file.
Hope this helps
The Macro is able to create email,but the macro are being kept in draft mode,Can you help that the mail is automatically sent
 
The Macro is able to create email,but the macro are being kept in draft mode,Can you help that the mail is automatically sent
Hi,

Like I said, just comment ".Display" and uncomment ".Send"... as follows:
Code:
Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object

    For Each c In Range("A2:A" & Columns("A").Cells(Rows.Count).End(xlUp).Row).Cells

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
 
    With OutLookMailItem
            .To = c.Offset(0, 1).Value
            .Subject = c.Offset(0, 2).Value
            .HTMLbody = "Dear " & c.Value & "<br>" & c.Offset(0, 3).Value & "<br>" & c.Offset(0, 4).Value & "<br>" & c.Offset(0, 5).Value & "<br>" & c.Offset(0, 6).Value
'           .Display
             .Send
  End With
    Next c

End Sub
 
Hi
Thanks a lot for the help
Is there a code that can be added to above code so that a image can be inserted at end of email.The image will be saved on my desktop and will be a .jpg file.
 
Hi
Thanks a lot for the help
Is there a code that can be added to above code so that a image can be inserted at end of email.The image will be saved on my desktop and will be a .jpg file.
Hi,

Hope you had a great weekend :)

As for the code, just add the following, replacing "MyPic" with the name of the file and "User" with your user name:
Code:
.Attachments.Add "C:\Users\User\Desktop\MyPic.jpg", _
       olbyvalue, 0
.HTMLBody = .HTMLBody & "<br>" & "<img src='cid:MyPic.jpg'"

Immediately before ".Display"... like this:
Code:
Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    For Each c In Range("A2:A" & Columns("A").Cells(Rows.Count).End(xlUp).Row).Cells
    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
  
    With OutLookMailItem
            .To = c.Offset(0, 1).Value
            .Subject = c.Offset(0, 2).Value
            .HTMLBody = "Dear " & c.Value & "<br>" & c.Offset(0, 3).Value & "<br>" & c.Offset(0, 4).Value & "<br>" & c.Offset(0, 5).Value & "<br>" & c.Offset(0, 6).Value
            .Attachments.Add "C:\Users\User\Desktop\MyPic.jpg", _
                olbyvalue, 0
            .HTMLBody = .HTMLBody & "<br>" & "<img src='cid:MyPic.jpg'"
            .Display
'            .Send
    End With
    Next c

End Sub
 
Back
Top