X500 Address shows instead of email address when transferring to Excel sheet

So I have been tasked with getting a list of all the users who sent mail to a mailbox in Outlook and transferring it to an excel sheet. Specifically, the sender's name, email address, as well as retrieving the sender's alias from the GAL address book. I've figured out how to do it, but I've run into two major problems:

1. For a somewhat large amount of the users, instead of their email address transferring, the X500 address is what shows up as follows: /O=OREGON STATE UNIVERSITY/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN //This is just an example I found online but the format is exactly the way it shows up in the excel sheet.
2. The alias for one user sometimes gets repeated to the wrong user. This also is happening to a somewhat large amount of users. What could be causing this? How can I fix this problem so the email address shows up and the correct alias is transferred to its respective user? //I feel it's also important to note that in the mailbox where I am transferring the information, several users actually emailed to it more than once. Could that be what's causing the problem with the user's alias?

Also I'm a beginner in VBA, so maybe not getting too technical would be helpful. Thanks in advance.
Here's the code I have (which the majority of I found online):

HTML Code:

---

Sub CopyToExcel()
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim oAL As Outlook.AddressList
 Dim olAE As Outlook.AddressEntries
 Dim oAE As Outlook.AddressEntry

 Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim olItem As Outlook.MailItem
 Dim obj As Object
 Dim strColB, strColC, strColD As String



enviro = CStr(Environ("USERPROFILE"))
'where to find excel sheet
strPath = enviro & "\Documents\EmailList.xlsx"
  On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If err <> 0 Then
    Set xlApp = CreateObject("Excel.Application")
    End If

 'Where to transfer the info
 Set xlWB = xlApp.workbooks.Open(strPath)
 Set xlSheet = xlWB.sheets("Sheet1")


'Find the next empty line of the worksheet
 rCount = xlSheet.Range("C" & xlSheet.Rows.Count).End(4000).Row

' where to find the information
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
 For Each obj In Selection
  Set olItem = obj

'extract the information

strColB = olItem.SenderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Sender.GetExchangeUser.Alias


'Get the Exchange address
 Dim olEU As Outlook.ExchangeUser
 Dim oEDL As Outlook.ExchangeDistributionList
 Dim recip As Outlook.Recipient
 Set recip = Application.session.CreateRecipient(strColB)

If InStr(1, strColC, "/") > 0 Then
 'if exchange, get smtp address
  Select Case recip.AddressEntry.AddressEntryUserType
      Case OlAddressEntryUserType.olExchangeUserAddressEntry
        Set olEU = recip.AddressEntry.GetExchangeUser
        If Not (olEU Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
        End If
      Case OlAddressEntryUserType.olOutlookContactAddressEntry
        Set olEU = recip.AddressEntry.GetExchangeUser
        If Not (olEU Is Nothing) Then
          strColC = olEU.PrimarySmtpAddress
        End If
      Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
        Set oEDL = recip.AddressEntry.GetExchangeDistributionList
        If Not (oEDL Is Nothing) Then
          strColC = olEU.PrimarySmtpAddress
        End If
    End Select
End If

'write them in the excel sheet
  xlSheet.Range("B" & rCount) = strColB
  xlSheet.Range("C" & rCount) = strColC
  xlSheet.Range("D" & rCount) = strColD

'Next row
 rCount = rCount + 1

Next

 xlWB.Close 1
 If bXStarted Then
    xlApp.Quit
 End If

 Set olItem = Nothing
 Set obj = Nothing
 Set currentExplorer = Nothing
 Set xlApp = Nothing
 Set xlWB = Nothing  Set xlSheet = Nothing

---