Vba 如何从联系人属性获取别名

我正在尝试从发件人的电子邮件地址获取收到的每封电子邮件的别名ID。
要获取别名，可以右键单击收到的电子邮件，选择“打开Outlook属性”

我构建了一个代码，用于从单元格B中指定的特定日期提取收件箱中收到的电子邮件。
我正在尝试在D4之后添加别名ID

子GetFromOutlook（）
Dim OutlookApp作为Outlook.Application
Dim OutlookNamespace作为命名空间
将文件夹设置为MAPIFolder
Dim OutlookMail作为变体
作为整数的Dim i
Dim OLEXCHNGUSER作为交换机用户
Set-OutlookApp=新建Outlook.Application
设置OutlookNamespace=OutlookApp.GetNamespace（“MAPI”）
Set Folder=OutlookNamespace.Folders（“插入您自己的电子邮件地址”）.Folders（“收件箱”）
i=1
对于文件夹中的每个OutlookMail.Items
如果OutlookMail.ReceivedTime>=范围（“电子邮件接收日期”）。值，则
范围（“电子邮件主题”）.Offset（i，0）。值=OutlookMail.Subject
''别名这是我试图从每个项目获取别名作为循环的一部分的地方
将名称空间设置为名称空间
Dim OLADDRIST作为地址列表
Set olAddrList=OutlookNamespace.addresslist（“全局地址列表”）
设置olExchgnUser=olAddrEntry.GetExchangeUser
使用Olexchgner
范围（“别名”）.Offset（i，0）=.Alias
以
“结束别名”
范围（“电子邮件主题”）。偏移量（i，0）。列。自动拟合
范围（“电子邮件主题”）。偏移量（i，0）。垂直对齐=xlTop
范围（“电子邮件日期”）.Offset（i，0）。值=OutlookMail.ReceivedTime
范围（“电子邮件发送日期”）。偏移量（i，0）。列。自动拟合
范围（“电子邮件日期”）。偏移量（i，0）。垂直对齐=xlTop
范围（“电子邮件发件人”）.Offset（i，0）。值=OutlookMail.SenderName
范围（“电子邮件发件人”）。偏移量（i，0）。列。自动拟合
范围（“电子邮件发送者”）。偏移量（i，0）。垂直对齐=xlTop
范围（“电子邮件正文”）.Offset（i，0）。值=OutlookMail.Body
范围（“电子邮件正文”）。偏移量（i，0）。列。自动拟合
范围（“电子邮件正文”）。偏移量（i，0）。垂直对齐=xlTop
i=i+1
如果结束
下一期展望邮件
设置文件夹=无
Set-OutlookNamespace=Nothing
Set-OutlookApp=无
MsgBox“操作完成”
端接头

更换线路

 Set olAddrList = OutlookNamespace.AddressLists("Global Address List")
 Set olExchgnUser = olAddrEntry.GetExchangeUser

与

（省略null和错误处理）

---

你真的不应该循环浏览文件夹中的所有邮件-使用

项目。查找/FindNext

或

项目。限制

没有Exchange，我帮不了你，但是这个论坛上类似问题的答案呢？

 Set olExchgnUser = OutlookMail.Sender.GetExchangeUser