Send data from Excel in email from specific email account

I have been very successful in using the 1st macro to insert specific data from a spreadsheet into an email and send it. The only problem is that I need to send it from a specific account in Outlook. I found the 2nd macro which works to send from a specific account in Outlook but I am not able to find something similar to work with Excel and integrate with the 1st code. If anyone can help me, this would be more than appreciated!

1st Macro

Private Declare Function ShellExecute  _ 
  Lib "shell32.dll" _
    Alias "ShellExecuteA" _ 
      (ByVal hwnd As Long, _ 
       ByVal lpOperation As String, _
       ByVal lpFile As String, _ 
       ByVal lpParameters As String, _ 
       ByVal lpDirectory As String, _
       ByVal nShowCmd As Long) As Long

Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 2 To 4 'data in rows 2-4
'       Get the email address
        Email = Cells(r, 2)
        
'       Message subject
        Subj = "Your Annual Bonus"

'       Compose the message
        Msg = ""
        Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
        Msg = Msg & "I am pleased to inform you that your annual bonus is "
        Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "William Rose" & vbCrLf
        Msg = Msg & "President"
        
'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
                
'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")        

'       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
        
'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%s"
    Next r
End Sub

2nd Macro

Sub NewMail()

  Dim objOLApp As Outlook.Application
  Dim NewMail As Outlook.MailItem

    Set objOLApp = New Outlook.Application
    Set NewMail = objOLApp.CreateItem(olMailItem)

      NewMail.SentOnBehalfOfName = "email@domain.com"
      NewMail.Display

End Sub