Senders Email Address: Outlook 2013 to Excel 2013 Not Working

[Forex-Forex]

Hi Community

I have exhausted all possible solutions and still cannot get this to function at work. It works at home on Excel/Outlook 2016

At work I am using Excel/Outlook 2013 and all the columns are populated except the Sender's email address. That column remains blank.

I have shown the code I am using below. Can someone suggest what may be wrong that it is not working at Work using Excel/Outlook 2013 please?

I have also attached the file.



Function Get_Sender_Address(Item As MailItem)
Dim s As String, objSender As Outlook.AddressEntry, PA As Variant, i As Byte
Dim strEmail As String

If Item.SenderEmailType <> "EX" Then
Get_Sender_Address = Item.SenderEmailAddress
Exit Function
End If

PA = Array("0x5D01001F", "0x5D02001F", "0x800F101F", "0x39FE001E", "0x39FE001F", "0x5D09001F", "0x0C1F001E")

On Error GoTo e

s = "Type1" & vbCrLf
For i = LBound(PA) To UBound(PA)
strEmail = Item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/" & PA(i))
If InStr(1, strEmail, "@") Then
Get_Sender_Address = strEmail
Exit Function
End If
Next i

Set objSender = Item.sender
For i = LBound(PA) To UBound(PA)
strEmail = objSender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/" & PA(i))
If InStr(1, strEmail, "@") Then
Get_Sender_Address = strEmail
Exit Function
End If
Next i


strEmail = objSender.GetExchangeUser.PrimarySmtpAddress
If InStr(1, strEmail, "@") Then
Get_Sender_Address = strEmail
Exit Function
End If

strEmail = Item.SmtpAddress
If InStr(1, strEmail, "@") Then
Get_Sender_Address = strEmail
Exit Function
End If

e:
Err.Clear
Resume Next
End Function