Excel VBA code to send emails from a specific shared email Account from Outlook not working (.senton-CodePudding

I have the below code that works perfectly well sending emails from my excel file. However I do not know where to add the .sentonbehalf of line to send from a specific shared email that I have the access to send from. Any help is greatly appreciated.

Sub send_email()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Statements")
    
    Dim OA As Object
    Dim msg As Object
    
    Set OA = CreateObject("Outlook.Application")
    Dim each_row As Integer
    Dim last_row As Integer
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
  
    For each_row = 2 To last_row
          Set msg = OA.createitem(0)
          msg.To = sh.Range("A" & each_row).Value
          first_name = sh.Range("B" & each_row).Value
          last_name = sh.Range("C" & each_row).Value
          msg.cc = sh.Range("D" & each_row).Value
          msg.Subject = sh.Range("E" & each_row).Value
          msg.body = sh.Range("F" & each_row).Value
          date_to_send = sh.Range("H" & each_row).Value
          date_to_send = Format(date_to_send, "dd/mm/yyyy")
          Status = sh.Range("I" & each_row).Value
          current_date = Format(Date, "dd/mm/yyyy")
          If date_to_send = current_date Then
                If sh.Range("G" & each_row).Value <> "" Then
                msg.attachments.Add sh.Range("G" & each_row).Value
                Cells(each_row, 9).Value = "Sent"
                Content = Replace(msg.body, "<>", first_name   " "   last_name)
                msg.body = Content
                msg.send
            Else
                Cells(each_row, 9).Value = "Sent"
                Content = Replace(msg.body, "<>", first_name   " "   last_name)
                msg.body = Content
                msg.send
            End If
          End If
         
    Next each_row
End Sub

CodePudding user response：

Try adding

 msg.SentOnBehalfOfName = "Your shared email address"

above this line

 msg.cc = sh.Range("D" & each_row).Value

It worked for me!