many emails and many call macros

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
392
Office Version
  1. 365
Platform
  1. Windows
hi
i messed up
my code worked when it was only email1 and email2 i guess i didnt add 3 and 4 correctly. was i maent to have a sub that lists all my macros as call email1 call email2
can someone sort it out for me?

VBA Code:
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)
                   
                    Call SendEmail1(Target, "mail@mail") 'Email 1
                    Call SendEmail2(Target, "mail@mail") 'Email 2
                    MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
                End If
            End If
        End If
    End If
End Sub

Private Sub SendEmail1(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget was approved" ' Add Subject
        .Body = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "I").Value & vbCrLf & "" & _
                "Please prepare Budget Description " ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub

Private Sub SendEmail2(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget was approved" ' Add Subject
        .Body = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "I").Value & vbCrLf & "" & _
                "Please train broker for proper reimbursement billing" ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub
Private Sub AmendedBudget(ByVal Target As Range)

    If Target.Cells.Count = 1 Then
        If Target.Column = 11 Or Target.Column = 12 Then
            If Cells(Target.Row, "K").Value <> "" Or Cells(Target.Row, "L").Value <> "" Then
            result = MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended 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)
                   
                    Call SendEmail3(Target, "mail@mail") 'Email 3
                    Call SendEmail4(Target, "mail@mail") 'Email 4
                    MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
                End If
            End If
        End If
    End If
End Sub
Private Sub SendEmail3(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " Amended budget was approved" ' Add Subject
        .Body = "Now that there is an amended budget approval for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description " ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub

Private Sub SendEmail4(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget amendment was approved" ' Add Subject
        .Body = "This is a notification that an amended budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please update the records according to the information on the SD grid" ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
392
Office Version
  1. 365
Platform
  1. Windows
i copied exactly and only updated the email address
column P wont work
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
i copied exactly and only updated the email address
column P wont work

I don't understand what doesn't work for you.
If I capture a letter in column "I" an email is generated.
If I capture a letter in column "K" an email is generated.
If I capture a letter in column "L" an email is generated.
If I capture a letter in column "P" an email is generated.

How it doesn't work for you.

The code you entered is not complete.

You did not completely copy the macro.

I annex the macro again.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sMail As String, sSubj As String, sBody As String

  If Target.CountLarge > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  If Not Intersect(Target, Range("I:I, K:L, P:P")) Is Nothing Then
    If Target.Column = 9 Then
      If MsgBox("Pressing OK will send email to notify", vbOKCancel + vbInformation, "Budget Approved") = vbOK Then
        
        'Data for MAIL 1
        sMail = "mail_1@mail"
        sSubj = Cells(Target.Row, "A").Value & " budget was approved"
        sBody = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & _
                Cells(Target.Row, "I").Value & vbCrLf & "" & "Please prepare Budget Description "
        Call SendMail(sMail, sSubj, sBody)
        
        'Data for MAIL 2
        sMail = "mail_2@mail"
        sSubj = Cells(Target.Row, "A").Value & " budget was approved"
        sBody = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & _
                Cells(Target.Row, "I").Value & vbCrLf & "" & "Please train broker for proper reimbursement billing"
        Call SendMail(sMail, sSubj, sBody)
      
        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      End If
    ElseIf Target.Column = 11 Then 'column "K"
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 3
        sMail = "mail_3@mail"
        sSubj = Cells(Target.Row, "A").Value & " Amended budget was approved"
        sBody = "Now that there is an amended budget approval for " & _
                Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 4
        sMail = "mail_4@mail"
        sSubj = Cells(Target.Row, "A").Value & " budget amendment was approved"
        sBody = "This is a notification that an amended budget was approved for " & _
                Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please update the records according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      End If
    ElseIf Target.Column = 12 Then  'column "L"
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 5
        sMail = "mail_5@mail"
        sSubj = Cells(Target.Row, "A").Value & " Amended budget was approved"
        sBody = "Now that there is an amended budget approval for " & _
                Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "L").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 6
        sMail = "mail_6@mail"
        sSubj = Cells(Target.Row, "A").Value & " budget amendment was approved"
        sBody = "This is a notification that an amended budget was approved for " & _
                Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "L").Value & vbCrLf & "" & _
                "Please update the records according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      End If
    ElseIf Target.Column = 16 Then  'column "P"
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 7
        sMail = "mail_7@mail"
        sSubj = Cells(Target.Row, "A").Value & " hass DPP services. "
        sBody = "Since the following participant has DPP Services " & vbCrLf & "" & _
                "Please update SD Participants sheet accordingly. "
        Call SendMail(sMail, sSubj, sBody)
      
        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
        
      End If
    End If
  End If
End Sub

Sub SendMail(sMail, sSubj, sBody)
  Dim OutlookApp As Object
  Set OutlookApp = CreateObject("Outlook.Application").CreateItem(0)
  With OutlookApp
    .To sMail
    .Subject = sSubj
    .Body = sBody
    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
please see what i did wrong
1593536968532.png
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
392
Office Version
  1. 365
Platform
  1. Windows
thanks so much
it all works now
you are so patient
stay safe
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
392
Office Version
  1. 365
Platform
  1. Windows
hi
its erroring out again at this point see red

With OutlookApp
.To sMail
.Subject = sSubj
.Body = sBody
.Display 'Display Email
.Send 'Send Email
End With
End Sub
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
392
Office Version
  1. 365
Platform
  1. Windows
hi
when i copied the last full code seems like a mistake crept in on your end
i went back to the beginning on page 1 and found the error
it was meant to be:
.to-sMail
 

Watch MrExcel Video

Forum statistics

Threads
1,127,550
Messages
5,625,445
Members
416,106
Latest member
Geo0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top