如何处理缺少的MAPI属性？

Question

以下代码针对缺少的MAPI属性引发错误。有些电子邮件具有此功能，因为我可以Debug.Print，但是随后一封电子邮件会触发错误。

-2147221233：属性“ http://schemas.microsoft.com/mapi/proptag/0x39FE001E”未知或找不到。

我应该怎么做才能捕捉到这些错误并继续前进而不是去我的错误处理程序？

我的代码进行高级搜索，然后循环遍历表以打印所有内容：

Public Sub SearchOutlook()

'Create Email
'Generate Outlook Email for L&E
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutRecip As Outlook.Recipient
Dim QuitNewOutlook As Boolean
Dim Session As Outlook.Namespace
Dim ExchangeStatus  As OlExchangeConnectionMode
Dim objExUser As Outlook.ExchangeUser
Dim objExDisUser As Outlook.ExchangeDistributionList
Dim Scope As String
Dim Filter As String
Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.row
m_SearchComplete = False

On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
On Error GoTo OutlookErrors

If OutApp Is Nothing Then
    Set OutApp = CreateObject("Outlook.Application")
    QuitNewOutlook = True
End If

Set Session = OutApp.GetNamespace("MAPI")
Session.Logon

'We need to ensure outlook is fully connected
ExchangeStatus = Session.ExchangeConnectionMode
If ExchangeStatus <> 700 Then GoTo OutlookErrors

Set OutlookEventClass.oOutlookApp = OutApp

'set scope
Scope = "'" & OutApp.Session.Folders("[email protected]").FolderPath & "'"

'Establish filter - DASL schemas below:
'Message ID http://schemas.microsoft.com/mapi/proptag/0x1035001E = <[email protected]>
'Subject urn:schemas:httpmail:subject ci_phrasematch 'blah' - Our store uses instant search
'Body urn:schemas:httpmail:textdescription ci_phrasematch 'blah'
'From urn:schemas:httpmail:fromemail
'To urn:schemas:httpmail:to
'cc urn:schemas:httpmail:cc

Dim SubjectsAndBodyToSearch() As String
Dim IDsToNotSearch() As String

Dim IDString As String

'SubjectsAndBodyToSearch = ActiveRecordset.GetRows(ActiveRecordset.RecordCount, "field")
SubjectsAndBodyToSearch = Split("cat,dog", ",")

Filter = SubjectSearchSchema(SubjectsAndBodyToSearch, OutApp.Session.DefaultStore.IsInstantSearchEnabled) & " OR " & _
         BodySearchSchema(SubjectsAndBodyToSearch, OutApp.Session.DefaultStore.IsInstantSearchEnabled)

If IDString <> "" Then
    Filter = Filter & " OR " & _
         " NOT ( " & MessageIDSearchSchema(IDsToNotSearch) & ")"
End If

Set MySearch = OutApp.AdvancedSearch(Scope, Filter, True, "MySearch")

'loop until event triggers that search is complete
While m_SearchComplete <> True
    DoEvents
Wend

Set MyTable = MySearch.GetTable
MyTable.Columns.Add ("http://schemas.microsoft.com/mapi/proptag/0x1035001E") 'messageID
MyTable.Columns.Add ("http://schemas.microsoft.com/mapi/proptag/0x00710102") 'conversationID
MyTable.Columns.Add ("urn:schemas:httpmail:textdescription") 'messagebody, outmail.Body

Dim SenderInfo As String
Dim RecipientsTo As String
Dim RecipientsCC As String
Dim RecipientsBCC As String
Dim MessageBody As String
Dim MessageID As String
Dim ConversationID As String

Do Until MyTable.EndOfTable

    Set nextRow = MyTable.GetNextRow()
    Set OutMail = Session.GetItemFromID(nextRow("EntryID"))

    MessageID = nextRow("http://schemas.microsoft.com/mapi/proptag/0x1035001E")
    ConversationID = nextRow("http://schemas.microsoft.com/mapi/proptag/0x00710102") 'outmail.conversationID
    MessageBody = nextRow("urn:schemas:httpmail:textdescription") 'outmail.Body

    'Sender Info
    If OutMail.SenderEmailType = "EX" Then
        SenderInfo = OutMail.Sender.GetExchangeUser.PrimarySmtpAddress
    Else
        SenderInfo = OutMail.SenderEmailAddress
    End If

    If SenderInfo <> "" Then

        RecipientsTo = ""
        RecipientsCC = ""
        RecipientsBCC = ""

        For Each OutRecip In Session.GetItemFromID(nextRow("EntryID")).Recipients
            'Debug.Print OutRecip.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
            'Debug.Print OutRecip.Address & " Type=" & OutRecip.Type & " " & OutMail.PropertyAccessor.GetProperty("urn:schemas:httpmail:fromemail")
            If OutRecip.Type = 1 Then
                RecipientsTo = RecipientsTo & ";" & OutRecip.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
            ElseIf OutRecip.Type = 2 Then
                RecipientsCC = RecipientsCC & ";" & OutRecip.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
            ElseIf OutRecip.Type = 3 Then
                RecipientsBCC = RecipientsBCC & ";" & OutRecip.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
            End If
        Next

        Debug.Print "Subject:" & nextRow("Subject") & " EntryID:" & nextRow("EntryID") & " From:" & SenderInfo & " To:" & RecipientsTo & " CC:" & RecipientsCC & " BCC:" & RecipientsBCC & " MessageID:" & MessageID & " ConversationID: " & ConversationID & "Body: " '& MessageBody

    End If
Loop

If QuitNewOutlook Then
    OutApp.Quit
End If

Set OutMail = Nothing
Set OutApp = Nothing
'Set ExchangeStatus = Nothing Possible Memory Leak?

'QueryRunning = False
Exit Sub

OutlookErrors:

    Debug.Print Err.Number & " : " & Err.Description
    Call ActivateUniversalSplashScreen("Outlook Error! Either restart or try again later.", MMCARMS.UploadBlurrImage, True, "Error")
    If DatabaseMethods.SQLIsConnectionOpen Then
        DatabaseMethods.SQLCloseDatabaseConnection
    End If

    Set OutMail = Nothing
    'Set ExchangeStatus = Nothing Possible Memory Leak?
    If Not OutApp Is Nothing And QuitNewOutlook Then
        OutApp.Quit
    End If
    Set OutApp = Nothing

End Sub

Answer 1

该异常是设计使然-您必须处理它。毫无疑问，除了支持结构化异常处理的VBA之外，其他语言都更容易。

在VBA中，最好的办法是调用On Error Resume Next /Err.Clear/引发异常的调用代码/选中Err.Number和Err.Description。

请参见https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/err-object以获取更多详细信息。