Hi there,

I'm trying to write VBA code to send email from a shared mailbox to which I have full permissions. The below VBA code sends email from the primary outlook account, but I've been unable to send from a different mailbox address("From" field) configured on the same account. I've tried ".SendUsingAccount" and ".SendonBehalfofName", but those are used in the case of different outlook accounts altogether. Please advise. Here's the code.

Dim ws         As Worksheet
Dim olApp       As Outlook.Application
Dim mailbody    As String
Dim iR        As Long
Dim strbody As String, strbody1 As String, strBody2 As String, strBody3 As String
Dim strbody4 As String, strbody5 As String, strBody6 As String, strfirst As String
Dim strbody8 As String, strbody9 As String, strBody10 As String, strBody11 As String
Dim strBody14 As String, strBody15 As String
Dim trackURL As String
Dim trackURL2 As String


    Set olApp = New Outlook.Application

    For Each ws In ActiveWorkbook.Worksheets
        With ws
        mailbody = "<TABLE Border=""1"", Cellspacing=""0""><TR>" & _
 "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">Application*</p></Font></TD>" & _
    "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">User ID*</p></Font></TD>" & _
 "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">Firstname*</p></Font></TD>" & _
    "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">Middlename*</p></Font></TD>" & _
       "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">LastName*</p></Font></TD>" & _
       "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">Department*</p></Font></TD>" & _
          "<TD Bgcolor=""#2B1B17"", Align=""Center""><Font Color=#FCDFFF><b><pstyle=""font-size:18px"">Positionnumber*</p></Font></TD>" & _
                       "</TR>"
            For iR = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
                mailbody = mailbody & "<TR>" & _
                           "<TD><center>" & .Cells(iR, "A").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "B").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "C").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "D").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "E").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "F").Value & "</TD>" & _
                           "<TD><center>" & .Cells(iR, "G").Value & "</TD>" & _
                           "</TR>"
            Next iR

            With olApp.CreateItem(olMailItem)
                trackURL = "<a href=""http://requestmanager.pfizer.com"">Request Manager</a>"
                trackURL2 = "<a href=""http://pdocsanon/pdocsanon/component/getcontent?objectId=0901179d8017d7ca&chronicleId=0901179d8005f96e&status=Effective"">Form10</a>"
                strfirst = ws.Range("H2").Value
                strbody = "Hello " & strfirst & "," & "<br>"
                strbody1 = "You have been identified as a manager with a resource " & _
                "who recently had a department/position change and has access to a PGS application."
                strBody2 = "<B>What actions do you need to take?</B>"
                strBody11 = "   1) Review  the PGS account list below."
                strBody3 = "    2) Take the following action for each resource:"
           strbody4 = "<DD> a)  If the level of access <b> does not </b> need to change and account is still needed no action is required from you."
                strbody5 = "b)  If the role change requires any change in access please access " & trackURL & _
                " to submit an account change or revoke the account.&nbsp;&nbsp;If you require assistance please contact your local BT group.</DD>"
                strBody6 = "    3)  If the resource resides within PGS-BT, please work with the resource and previous manager to submit a " & trackURL2 & _
                " to PLS within two business days."
                strBody14 = "Thank you in advance for helping keep PGS in compliance!"
                strBody15 = "- PGS-BT Account Management"
                
'-- Formulas
                Msg = strbody & "<br>" & strbody1 & "<br>" & "<br>" & strBody2 & "<br>" & strBody11 & "<br>" & strBody3 & "<br>" & _
                strbody4 & "<br>" & strbody5 & strBody6 & "<br>" & "<br>" & _
                strBody14 & "<br>" & "<br>" & strBody15 & "<br>" & "<br>"
                '.From = "PGS Account Review"
                .To = ws.Range("K2").Value
                .CC = "PGSAccountReview@pfizer.com"
                .Subject = "Action Requested - PGS Access Review After Worker Dept/Position Change "
                .HTMLBody = "<FONT color=#000000 face=Calibri size=3>" & Msg & mailbody & "</Table>"
                '.Display
                .Send
            End With
        End With
    Next ws
End Sub