vba - 在邮件项目上使用 GetConversation 时出现错误 438

Question

我正在尝试将共享收件箱中的所有电子邮件导出到 Excel。我特别感兴趣的是我进行了多少次对话，而不是我收到的所有电子邮件。

我正在438 error 上Set conv = Item.GetConversation()线：

对象不支持此属性或方法。

这意味着 Item 不支持 GetConversation，即使它是 MailItem 的函数。

    Public Sub ExportToExcel()
        Dim objOL As Outlook.Application
        Dim objNS As Outlook.NameSpace
        Dim SubFolder As Object
        Dim MailFolder As Object
        Dim SharedInbox As Outlook.MAPIFolder
        Dim objRecip As Outlook.Recipient

        Dim Item As Object
        Dim conv As Object
        Dim store As Outlook.Store

        Dim xlApp As New Excel.Application
        Dim xlWB As Excel.Workbook
        Dim i As Long
        Dim ArrHeader As Variant

        On Error GoTo MsgErr

        Set objOL = Application
        Set objNS = objOL.GetNamespace("MAPI")
        Set objRecip = objNS.CreateRecipient("[e-mail]")
        Set SharedInbox = objNS.GetSharedDefaultFolder(objRecip, olFolderInbox)

        Set MailFolder = SharedInbox.Folders("Archive").Folders("Sub")


        ArrHeader = Array("Category", "Date Sent", "Subject", "Mails in conversation")

        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Set xlWB = xlApp.Workbooks.Add


        xlWB.Worksheets(1).Range("A1").resize(1, UBound(ArrHeader) + 1).Value = ArrHeader

        For Each SubFolder In MailFolder.Folders
            For Each Item In SubFolder.Items
                If (Item.Class = olMail) Then
                    store = SubFolder.store

                    If (store.IsConversationEnabled) Then
                        Set conv = Item.GetConversation()

                        If (conv <> Null) Then
                            xlWB.Worksheets(1).Cells(i + 1, "A").Value = SubFolder.Name
                            xlWB.Worksheets(1).Cells(i + 1, "B").Value = Item.ReceivedTime
                            xlWB.Worksheets(1).Cells(i + 1, "C").Value = Item.Subject
                            xlWB.Worksheets(1).Cells(i + 1, "D").Value = conv.GetTable().getrows()
                        End If
                    End If
                End If
            Next Item
        Next SubFolder

        xlWB.Worksheets(1).Cells.EntireColumn.Autofit

    MsgErr_Exit:
        Set emailSourceFolder = Nothing
        Set emailDestFolder = Nothing
        Set objNS = Nothing
        Set objOL = Nothing
        Set SubFolder = Nothing
        Set MailFolder = Nothing
        Set SharedInbox = Nothing
        Set objRecip = Nothing
        Set Item = Nothing
        Set conv = Nothing
        Set Store = Nothing
        Set xlWB = Nothing
        Set xlApp = Nothing
        Set i = Nothing
        Set ArrHeader = Nothing

        Exit Sub

    '// Error information
    MsgErr:
        MsgBox "An unexpected Error has occurred." _
             & vbCrLf & "Error Number: " & Err.Number _
             & vbCrLf & "Error Description: " & Err.Description _
             , vbCritical, "Error!"
        Resume MsgErr_Exit

    End Sub

标签： vbaoutlook