如何用VBA从Outlook指定账户提取发件人邮箱到Excel

原代码存在的问题 #

你的代码方向没问题，但有几处关键错误会导致运行失败：

• 变量OutlookApp未定义，应使用你声明的emailApp对象
• iSelect对象未初始化就调用SelectedAccount，会触发运行时错误
• GetDefaultFolder(olFolderInbox)默认获取的是Outlook当前默认账户的收件箱，无法定位到公共邮箱

正确实现思路 #

要访问指定公共邮箱，需先遍历Outlook所有账户，找到目标账户后，通过账户对应的存储对象获取收件箱，再遍历邮件提取发件人地址：

1. 初始化Outlook应用对象
2. 遍历Session.Accounts集合，匹配公共邮箱的显示名称
3. 通过匹配到的账户获取对应的存储（Store）
4. 从存储中获取默认收件箱文件夹
5. 遍历收件箱内的邮件，提取SenderEmailAddress

完整可运行代码示例 #

Public Sub test()

Dim emailApplication As Outlook.Application, emailAccounts As Outlook.Accounts
Dim emailAccount As Outlook.Account, tAccount As Outlook.Account
Dim emailStore As Outlook.Store, emailInbox As Outlook.Folder, tMail As Variant

Set emailApplication = New Outlook.Application
Set emailAccounts = emailApplication.Session.Accounts

' 遍历账户，替换为你的公共邮箱显示名称
For Each tAccount In emailAccounts
    If tAccount.DisplayName = "部门公共邮箱显示名称" Then: Set emailAccount = tAccount
Next

' 获取公共邮箱的存储和收件箱
Set emailStore = emailAccount.DeliveryStore
Set emailInbox = emailStore.GetDefaultFolder(olFolderInbox)

' 遍历邮件并打印发件人邮箱（可替换为写入Excel逻辑）
On Error Resume Next ' 跳过非邮件类型的项目（如会议邀请等）
For Each tMail In emailInbox.Items
    Debug.Print tMail.SenderEmailAddress
Next
Err.Clear

End Sub

代码说明 #

• 把"部门公共邮箱显示名称"替换为你Outlook中公共邮箱的实际显示名称（可在Outlook账户设置中查看）
• On Error Resume Next用于跳过收件箱内非邮件类型的项目（比如会议请求、任务等），避免类型不匹配错误
• 若要将提取的邮箱地址写入Excel，只需把Debug.Print替换为单元格赋值逻辑即可

内容的提问来源于stack exchange，提问作者Rational Redneck