Excel - SendOnbehalfof in Outlook

[xlbeginnerxl]

Hi

I'm looking for some help with a macro that my colleague has created. Rather than sending the email from my default outlook profile i'd like the email to be sentonbehalf of another mailbox. VBA code below needs to be amended so that it is sending from the specified mailbox rather than my default mailbox profile.

Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object


Set rng = Nothing


On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
rngcllcnt = rng.Cells.Count
'You can also use a fixed range if you want
'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
On Error GoTo 0


If rng Is Nothing Or rngcllcnt = 5 Then
'MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

StartMsg = Sheet5.Cells(25, 26) & "<br>" & "<br>" & Sheet5.Cells(26, 26) & _
MyMonth & Sheet5.Cells(27, 26) & Sheet5.Cells(28, 26) & "<br>" & "<br>"




'StartMsg = EmailBody
EndMsg = Sheet5.Cells(29, 26) & "<BR>" & "Amanda"

Dim PtnrCode As String

PtnrCode = PrctCd
PtnrName = Salutation

If SvTDrft = False Then
Ptnr = SendSentOnBehalfOfName
Else
Ptnr = "sendfrom@thisemailaddress.com"
End If
On Error Resume Next
With OutMail
.SentOnBehalfOfName = Ptnr
.CC = ""
.BCC = ""
.Importance = olImportanceHigh
'.From =""


.Subject = "URGENT ACTION REQUIRED - PSS System Access - " & PtnrCode


.HTMLBody = "<font face=calibri>" & "Dear "

'.Send 'or use
If SvTDrft = True Then
.Save
Else
.Send
End If
End With
On Error GoTo 0


With Application
.EnableEvents = True
.ScreenUpdating = False
End With


Set OutMail = Nothing
Set OutApp = Nothing
End Sub


I tried changing ptnr = SentOnBehalfOfName and then changed .From to .SentOnBehalfOfName but that didn't work. Any help would be appreciated.

Many thanks

 

[xlbeginnerxl]

Never mind, I just added .SentOnBehalfOfName = "emailaddress" above .To

Thanks.

 

[mole999]

if you don't have those permissions, i don't think exchange will allow you to fake it