message box and email 2 messages 2 recipients one action

[rjmdc]

hi
this is my message
it works great
i want to add with the same action 2 different emails to 2 different recipients meaning the same ok will send 2 different messages

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.Column = 9 Then
If Cells(Target.Row, "I").Value <> "" Then


result = MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Budget Approved")

If result = vbCancel Then SaveUI = True

If result = vbOK Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)

newmsg.Recipients.Add ("mail@mail.org")
newmsg.Subject = Cells(Target.Row, "A").Value & " budget was approved" ' Add Subject
newmsg.Body = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "I").Value & vbCrLf & "" & _
"Please prepare Budget Description and train broker for proper reimbursement billing" ' Email Body
newmsg.Display 'Display Email
newmsg.Send 'Send Email
MsgBox "Outlook message sent", , "Outlook message sent" ' Confirm Sent Email


End If
End If
End If
End If

End Sub

 

[Logit]

newmsg.Recipients.Add ("mail@mail.org","mail2.@mail.org")

 

[rjmdc]

that part i got
i can send the same email to as many people that i want

i want to know if with the same macro ans same ok on the message box 2 different emails go to 2 different people

 

[Logit]

Here is sample working code for emailing multiple addresses. You can adapt the code (the part re: multiple addresses) to your needs.
In this code, Recipient Names are in Col A and their matching email addresses are in Col B.

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail As Object
Dim FullIdNo As String
Dim strFilename As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow

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

        toList = Cells(i, 2)    'gets the recipient email address from col X
        eSubject = "This is your Subject"
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Just a quick note to advise your VIP Client's status at the show." & vbCrLf & vbCrLf & vbCrLf & _
        "Sincerely, " & vbCrLf & vbCrLf & _
        "John Doe "
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
        
        
    Application.Goto ActiveWorkbook.Sheets("Sheet1").Range("A1")

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
Next i

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

 

[rjmdc]

sorry
i am confused
i attached my code
when a certain field is filled in it sends an email notification
for the same action
can 2 different emails be generated