Send email via Excel button.

Hello Novice_704,

The recipients are added as an Array (see the code) with the names separated by commas. I have run the macro with only names that were in my address book. I haven't tested it using an email address in the Recipients.

Sub Macro3()
 Dim olApp As Outlook.Application
 Dim olNamespace As Outlook.Namespace
 
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    SendersName = olNS.CurrentUser
    
      ThisWorkbook.HasRoutingSlip = True

        With ThisWorkbook.RoutingSlip
          .Delivery = xlAllAtOnce
          .Recipients = Array("[email protected]", SendersName)
          .Subject = "Routing: New Owner Form"
          .Message = "Your Request has been received and will be added as a New Owner!"
         .ReturnWhenDone = False
         .TrackStatus = False        
      End With
        
     ThisWorkbook.Route
     
     MsgBox Prompt:="Email has been sent to Portfolio User Support" & MyVar, _
           Title:="Confirmation", _
           Buttons:=vbOKCancel
     Range("E7:M7").Select

   olApp.Quit
   Set olApp = Nothing
   Set olNS = Nothing

End Sub

If you have any problems with this code, please let me know.

Sincerely,
Leith Ross

All I am working on something similar.

I have a sheet that needs to be "approved" by multiple people.

What I need is this to be sent to one "approver" at a time.


Approvers name (recipient) are in cells B29, B31, B33 and B35. And sometimes not all 4 will be populated.


So I would create the sheet put the "recipients" in and hit the Button "ROUTE"

Then it will go to the firts person. There are drop downs that they will have to mark "approved" then hit a "ROUTE" button to send to the next person.


This macro goes to the first person and then sends it back to them.


Please help.

Private Sub CommandButton2_Click()
    ActiveWorkbook.HasRoutingSlip = True
    With ActiveWorkbook.RoutingSlip
        .Recipients = Range("B29", "B31")
        .Subject = "Plant" & " " & Range("B12") & " " & "WO#" & " " & Range("WO")
        .Message = "Please review this add-on test"
        .Delivery = xlOneAfterAnother
        .ReturnWhenDone = True
        .TrackStatus = True
    End With
    ActiveWorkbook.Route
End Sub