如何处理缺少的 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@something.com").FolderPath & "'"

'Establish filter - DASL schemas below:
'Message ID http://schemas.microsoft.com/mapi/proptag/0x1035001E = <blah.blah@blah.com>
'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。