为何将Outlook的olMail.Body属性赋值给String变量会触发应用定义错误

编辑1 #

我将.BodyFormat = olFormatPlain替换为如下代码后，仍返回相同错误：

olMailID = .EntryID
StoreID = fol.StoreID
Set olMail = ns.GetItemFromID(olMailID)

编辑2 #

在本地窗口中观察到Body属性无任何返回值

编辑3 #

我尝试了微软官方文档推荐的GetInspector方案，但是在Set wdDoc = myInspector.WordEditor行仍报相同错误，相关资料提示可能是Outlook安全特性阻止了正文提取，请问是否有其他解决方案？

Option Explicit

Sub Test()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
        ' Part 1
        
            Dim wb              As Workbook, _
                ws              As Worksheet, _
                tStamp1         As String, _
                EmailBody       As String, _
                wsCount         As Integer, _
                j               As Integer
                
                j = 2
                Set wb = ThisWorkbook
                Set ws = wb.Worksheets("Sheet1")
                tStamp1 = Format(DateAdd("h", 10, Date - 3), "ddddd h:nn AMPM")
                
            Dim ol              As Outlook.Application, _
                ns              As Namespace, _
                fol             As MAPIFolder, _
                subFolderItems  As Outlook.Items, _
                olMail          As Object, _
                olMailID        As String, _
                StoreID         As String

                Set ol = New Outlook.Application
                Set ns = ol.GetNamespace("MAPI")
                Set fol = ns.Folders("[insert folder]").Folders("[insert folder]").Folders("[insert folder]")
                Set subFolderItems = fol.Items
                Set subFolderItems = subFolderItems.Restrict("[ReceivedTime] > '" & tStamp1 & "' ")
                              
            Dim myInspector As Outlook.Inspector, _
                wdDoc As Word.Document, _
                wdRange As Word.Range
                       
        ' Part 2
            
            Do
                wsCount = wb.Worksheets.Count
                If wsCount > 1 Then
                    wb.Worksheets(2).Delete
                End If
                j = j + 1
            Loop Until wsCount = 1
            
            For Each olMail In subFolderItems
                With olMail
                    If .Subject Like "*[insert subject]*" Then

                        .Display
                        Set myInspector = .GetInspector
                        Set wdDoc = myInspector.WordEditor
                        Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
                        wdRange.InsertBefore ("EMAIL BODY")
                         
                    End If
                End With
            Next olMail

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

编辑4 #

我完全照搬了Stack Overflow上同类问题的实现代码，仍在相同位置触发错误，怀疑问题与Outlook安全设置或版本更新有关。

编辑5 #

为绕过可能的安全限制，我尝试直接在Outlook中运行VBA代码导出邮件，但在.SaveAs (Str), olTXT行仍触发相同错误，语法和枚举值确认无误。

Option Explicit

Sub Test()
        
    Dim ol              As Application, _
        ns              As Namespace, _
        fol             As MAPIFolder, _
        subFolderItems  As Items, _
        olMail          As Object, _
        Str             As String, _
        tStamp1         As String

        tStamp1 = Format(DateAdd("h", 10, Date - 1), "ddddd h:nn AMPM")
        Set ol = New Application
        Set ns = ol.GetNamespace("MAPI")
        Set fol = ns.Folders("[insert folder]").Folders("[insert folder]").Folders("[insert folder]")
        Set subFolderItems = fol.Items
        Set subFolderItems = subFolderItems.Restrict("[ReceivedTime] > '" & tStamp1 & "' ")
    
    For Each olMail In subFolderItems
        With olMail
            If .Subject Like "*[insert subject]*" Then
                
                Str = "[insert file path]"
                Str = Str & .Subject & ".txt"

                .SaveAs (Str), olTXT
            
            End If
        End With
    Next olMail

End Sub

编辑6 #

查阅资料得知该问题可能与Outlook邮件安全策略限制有关，但我无管理员权限修改对应设置，请问是否有其他可行的解决方案？

你遇到的报错本质是Outlook的程序访问安全机制拦截了未信任的VBA程序对邮件敏感属性的访问，以下方案均不需要管理员权限即可落地：

• 方案1：调整Outlook宏信任设置
  打开Outlook → 「文件」→ 「选项」→ 「信任中心」→ 「信任中心设置」→ 「宏设置」，勾选「信任对VBA工程对象模型的访问」，并将宏安全级别调整为「启用所有宏」，保存后重启Outlook重新运行代码即可。

  该操作仅修改当前用户的Outlook配置，不需要管理员权限。

• 方案2：改用MAPI属性直接读取正文
  绕过.Body属性的安全校验，通过PropertyAccessor读取邮件原生MAPI属性获取正文：

  ' 替换原有EmailBody = .Body 行代码即可
  Const PR_BODY As String = "http://schemas.microsoft.com/mapi/proptag/0x1000001F"
  EmailBody = olMail.PropertyAccessor.GetProperty(PR_BODY)
  

  如果需要读取HTML格式正文，替换PR_BODY为http://schemas.microsoft.com/mapi/proptag/0x1013001F即可。
• 方案3：改为后期绑定Outlook对象
  删除VBA编辑器「工具」→「引用」中的Outlook、Word类型库引用，将所有Outlook相关对象改为后期绑定，部分版本的Outlook对后期绑定的安全校验逻辑更宽松：

  Dim ol As Object, ns As Object, fol As Object
  Set ol = CreateObject("Outlook.Application")
  Set ns = ol.GetNamespace("MAPI")
  

• 方案4：确认设备防病毒状态有效
  Outlook默认会在设备防病毒状态为「有效」时自动放行VBA对邮件属性的访问，你可以在Outlook「信任中心」→「程序访问」页面查看当前防病毒状态，只要状态显示为有效，不需要修改任何设置即可正常运行代码。

内容的提问来源于stack exchange，提问作者Geoffrey Turner