VBA: create separate emails for each unique address in selection

[Leliana]

Hey

We have a database which we update daily and need to send an email to separate people based on the input. My code check selected cells per rows creates the emails. My problem is we need to manually check if we select cells from the same person otherwise we send it to the wrong person. For Instance I select 2 rows, one belonging to PersonA, one to PersonB, the code only makes one mail for PersonA, but with both inputs.
What we need is something like this. If I select 6 rows, 4 belonging to PersonA, 2 belonging to PersonB the code generates 2 emails and puts the 4 row's input to PersonA email and vica versa
Is this doable?
Thank you

Sub ExcelToOutlookSR()

Dim mApp As Object, mMail As Object
Dim SendToMail As String, MailSubject As String, mMailbody As String, TimeE As String, signature As String
Dim TimeS As Date

Set mApp = CreateObject("Outlook.Application")
Set mMail = Outlook.CreateItem(0)

With mMail
    .display
End With
 sig = mMail.HTMLBody

For Each r In Selection

SendToMail = Range("H" & r.row)
MailSubject = "data" & Range("B" & r.row)
TimeS = Range("C" & r.row)
TimeE = Range("M" & r.row)

mMailbody = "lots of data" & mMailbody
Range("O" & r.row).Interior.Color = RGB(153, 204, 0)
 
Next r


mMailbody = mMailbody & sig

With mMail
    .SentOnBehalfOfName = ""
    .To = SendToMail
    .CC = ""
    .Subject = MailSubject
    .HTMLBody = mMailbody
    .display
    End With
End Sub

 

[DanteAmor]

Hello @Leliana.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

This is your request:

If I select 6 rows, 4 belonging to PersonA, 2 belonging to PersonB the code generates 2 emails and puts the 4 row's input to PersonA

I have doubts. Continuing with your example.

- How are those 4 records going to get in the mail?​

- What data from those 4 rows goes in the mail?​

- Do you only need one subject per email or should multiple data be concatenated in the subject?​

According to your code you only read the data from columns C and M.
But I don't know how you put the data in "lots of data".

I show you a preview, each record will be on a line in the mail.
For example, in the following data "damor" is on lines 2, 4, 5 and 8:

Dante Amor
	A	B	C					H					M	N
1	A	B	C					H					M	N
2	A2	B2	06-may					damor					M2	N2
3	A3	B3	07-may					jov					M3	N3
4	A4	B4	08-may					damor					M4	N4
5	A5	B5	09-may					damor					M5	N5
6	A6	B6	10-may					jov					M6	N6
7	A7	B7	11-may					jov					M7	N7
8	A8	B8	12-may					damor					M8	N8
Hoja3

Then the mail will be displayed like this, 4 records under "lots of data"

Test the following macro:

Sub ExcelToOutlookSR()
  Dim mApp As Object, mMail As Object, Outlook As Object
  Dim SendToMail As String, MailSubject As String, mMailbody As String
  Dim TimeE As String, signature As String, sig As String
  Dim sLine As String, sj As String, sL As String
  Dim TimeS As Date
  Dim r As Range
  Dim dic As Object, ky As Variant
 
  Set mApp = CreateObject("Outlook.Application")
  Set dic = CreateObject("Scripting.Dictionary")
 
  For Each r In Selection
    SendToMail = Range("H" & r.Row).Value
    MailSubject = "data" & Range("B" & r.Row).Value
    TimeS = Range("C" & r.Row).Value
    TimeE = Range("M" & r.Row).Value
   
    sLine = TimeS & " " & TimeE
       
    If Not dic.exists(SendToMail) Then
      dic(SendToMail) = MailSubject & "|" & sLine
    Else
      sj = Split(dic(SendToMail), "|")(0)
      sL = Split(dic(SendToMail), "|")(1)
      sL = sL & "<br>" & sLine
      dic(SendToMail) = MailSubject & "|" & sL
    End If
   
    Range("O" & r.Row).Interior.Color = RGB(153, 204, 0)
  Next r
 
  For Each ky In dic.keys
    Set mMail = mApp.CreateItem(0)            'It should be mApp instead of outlook
    sig = mMail.HTMLBody
    mMailbody = "lots of data" & mMailbody
    mMailbody = mMailbody & sig
    sj = Split(dic(ky), "|")(0)
    sL = Split(dic(ky), "|")(1)
    mMailbody = mMailbody & "<br>" & sL
   
    With mMail
      .display
      .SentOnBehalfOfName = ""
      .To = ky
      .CC = ""
      .Subject = sj
      .HTMLBody = mMailbody '& .HTMLBody    'if you want signature
      .display
    End With
    sig = ""
    mMailbody = ""
  Next
End Sub

If the result is not what you need. So help me with an example of your data and how the mails should look like.
Look at my examples, you don't even have to put confidential data, just putting generic data and the result you want is enough to help you complete the macro.

But if I guessed what you need then you already have a macro to use


--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------