首页 > 解决方案 > 从 Outlook 365 检索发件人的电子邮件地址

问题描述

从 W7 上的 Office 2010 升级到 W10 上的 Office 365 后,以下代码停止工作。

Option Explicit

Sub test()

    Dim OL As Outlook.Application
    Dim ST As Outlook.Store
    Dim DSI As Outlook.Folder
    Dim Email As Outlook.MailItem

    Set OL = CreateObject("Outlook.Application")

    'Find Primary Mailbox
    For Each ST In OL.GetNamespace("MAPI").Stores
        If ST.ExchangeStoreType = olPrimaryExchangeMailbox Then
            Set DSI = ST.GetDefaultFolder(olFolderSentMail)
            Exit For
        End If
        Set ST = Nothing
    Next

    Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    For Each Email In DSI.Items
        Debug.Print Email.Sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
    Next

    Set Email = Nothing
    Set DSI = Nothing
    Set ST = Nothing
    Set OL = Nothing

End Sub

它现在在此行返回 287 运行时错误“应用程序定义或对象定义错误”。

Debug.Print Email.Sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)

我的研究表明这是一个信任问题。所以我尝试在代码中添加签名,但没有奏效。

我让它工作的唯一方法是直接在 Outlook VBA 上运行,并将签名应用于代码。但我需要能够从 excel VBA 运行它。

有什么建议么?

代码的目的是识别默认发送项目文件夹中已使用共享邮箱发送的电子邮件,并将它们移动到单独的文件夹(代码已在上面被删减以仅显示手头的错误)。正如我所说,代码在升级之前运行良好。

标签: excelvbaoutlookoffice365digital-signature

解决方案


微软似乎为 Outlook 自动化实施了安全规则。有可能的路线,你可以去:

  1. 使用 Outlook 所基于的低级代码 - 扩展 MAPI 或围绕此 API 的任何其他第三方包装器,例如 Redemption。

  2. 在 Outlook - Microsoft Outlook 安全管理器中使用为关闭此类安全触发器而设计的第三方组件。

  3. 设置组策略以避免此类触发器。

  4. 在系统上设置有效的防病毒软件。


推荐阅读