Macro to send outlook email from shared mailbox

[naveenrv]

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.

[/COLOR]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.  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


[COLOR=#333333]

 

[schielrn]

I think you can find your answer here:

VBA to send email via outlook. Sendusingaccount DataBase 19-Apr-10 10:37 AM

Hope that helps and post back if you do get it working, for someone's future reference.

If that doesn't work there may be something in the 2nd to last post here that you might be able to get to work:

Send Email - Exchange Shared Mailbox - Access World Forums

 

[schielrn]

I do not have a shared mailbox otherwise I would test it out and try to solve it for you.

 

[naveenrv]

Thanks Schielrn. I should've started by saying this: I'm a noob when it comes to VBA. I did take a look at the links and did modify my code a number of times, but couldn't get it to run correctly. This is probably a little too much to ask, but it'd be great if someone modify my original code to allow for the "from" address to be the mailbox address (say ABC is the mailbox name and ABC@xyz.com is the "FROM" email address)? Thanks a lot.

 

[jimrward]

change .from to

.SentOnBehalfOfName = "PGS Account Review"

 

[naveenrv]

change .from to

.SentOnBehalfOfName = "PGS Account Review"

Hi Jim,
Thanks for the reply. I tried ".SentonBehalfOfName" without luck. I guess this is used when there are two different outlook accounts in use. Here, I'm trying to send from the same account, only with a different mailbox address (I think it has something to do with namespaces, I'm not sure).

 

[jimrward]

you need to have been correctly setup in Active directory to be able to send on behalf of, which is an extra setting above being able to receive emails for a departmental account

I use sendonbehalfofname a lot so it works for me, so check out AD

 

[naveenrv]

Hi Jim,

.SentonBehalfofName works. I had to add the mailbox email address to the list of Delegates on Tools-->Options-->Delegates tab. Thank you!