Outlook 使用 GetSharedDefaultFolder 自动化选择 SharedMailbox 中的子文件夹时出现错误

问题描述 投票：0回答：3

以下代码用于计算特定

SharedMailbox
或其
subfolder
中的电子邮件数量。

我在 SharedMailbox 中选择子文件夹时遇到问题。 我已阅读有关 GetSharedDefaultFolder 的许多资源，包括这个。

但是，很难正确地将它们组合在一起。 如果您能对此提供帮助，那就太好了。

我在运行代码时遇到以下错误。

运行时错误“-2147221233 (80040010f)”自动化错误

Sub CountInboxSubjects()

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim MyFolder1 As Outlook.MAPIFolder
    Dim MyFolder2 As Outlook.MAPIFolder
    Dim MyFolder3 As Outlook.MAPIFolder
    Dim olMailItem As Outlook.MailItem
    Dim propertyAccessor As Outlook.propertyAccessor
    Dim olItem As Object
    Dim dic As Dictionary
    Dim i As Long
    Dim Subject As String
    Dim val1 As Variant
    Dim val2 As Variant

    val1 = ThisWorkbook.Worksheets("Data").Range("I2")
    val2 = ThisWorkbook.Worksheets("Data").Range("I3")

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    'Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olShareName = olNs.CreateRecipient("Shared_MailBox")
    Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)
    MsgBox (olFldr)

    Set MyFolder1 = olFldr.Folders("Sub_Folder")
    MsgBox (MyFolder1)
    Set MyFolder2 = MyFolder1.Folders("Sub_Sub_Folder")
    MsgBox (MyFolder2)
    Set MyFolder3 = MyFolder1.Folders("Sub_Sub_Folder2")
    MsgBox (MyFolder3)


    If ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Inbox" Then
        MyFolder = olFldr
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Folder" Then
        MyFolder = MyFolder1
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        MyFolder = MyFolder2
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        MyFolder = MyFolder3
    End If

    Set olItem = MyFolder.Items
    'Set myRestrictItems = olItem.Restrict("[ReceivedTime]>'" & Format$("01/01/2019 00:00AM", "General Date") & "' And [ReceivedTime]<'" & Format$("01/02/2019 00:00AM", "General Date") & "'")
    Set myRestrictItems = olItem.Restrict("[ReceivedTime]>'" & Format$(val1, "General Date") & "' And [ReceivedTime]<'" & Format$(val2, "General Date") & "'")

    For Each olItem In myRestrictItems
            If olItem.Class = olMail Then
            Set propertyAccessor = olItem.propertyAccessor
            Subject = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E1D001E")
            If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
        End If
    Next olItem

    With ActiveSheet
        .Columns("A:B").Clear
        .Range("A1:B1").Value = Array("Count", "Subject")
        For i = 0 To dic.Count - 1
            .Cells(i + 2, "A") = dic.Items()(i)
            .Cells(i + 2, "B") = dic.Keys()(i)
        Next
    End With

End Sub

故障排除后，我发现以下步骤有问题。

Set MyFolder1 = olFldr.Folders("Sub_Folder")
MsgBox (MyFolder1)

我希望消息框会返回子文件夹名称，但它报告错误。

运行时错误“-2147221233 (80040010f)”自动化错误

我找不到原因。谁能帮忙..

excel vba outlook
3个回答
0
投票

尝试使用收件人电子邮件地址，如果是收件人姓名，则尝试根据地址簿解决收件人...

Option Explicit
Public Sub Example()
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    Dim olNs As Outlook.Namespace
    Set olNs = olApp.GetNamespace("MAPI")

    Dim Recip As Outlook.Recipient
    Dim Inbox As Outlook.MAPIFolder

    Set Recip = olNs.CreateRecipient("[email protected]")
    Recip.Resolve

    If Recip.Resolved Then
        Set Inbox = olNs.GetSharedDefaultFolder _
                            (Recip, olFolderInbox)
    End If        

    Inbox.Display

End Sub
0
投票

当然，在访问共享文件夹之前，您必须根据地址簿解析收件人的姓名或地址。

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")    
    Set olShareName = olNs.CreateRecipient("Shared_MailBox")
    olShareName.Resolve
    If Recip.Resolved Then
       Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)
       ...
    End If

但是访问子文件夹时出现问题的原因不同......

首先，尝试取消选中 Exchange 帐户属性对话框的 

Download shared folders
上选中的 
Advanced tab
复选框。有关详细信息，请参阅检测 Outlook 中是否选中“下载共享文件夹”一文。

其次，请查看默认情况下，在 Outlook 2010 和 Outlook 2013 中以缓存模式下载共享邮件文件夹一文。您为 PC 上的 

CacheOthersMail
键设置了什么值？

请参阅访问共享邮箱中的子文件夹了解更多信息。

0
投票

即使这个问题已经很老了，我可能会建议像 @Om3r 那样在一个简单的 if 语句中定义您的共享电子邮件和您想要使用的文件夹。您可以通过姓名或电子邮件地址定义您的共享邮件。

Sub CountInboxSubjects()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
Dim olItem As Object


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olShareName = olNs.CreateRecipient("[email protected]")
olShareName.Resolve

 'select a folder based on a value in cell I5
If olShareName.Resolved Then
    If ThisWorkbook.Worksheets("Data").Range("I5") = "folder" Then
        Set olFldr = olNs.GetSharedDefaultFolder(olShareName, _
olFolderInbox).Folders("folder")
        Set olItems = olFldr.Items

    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Folder" Then
        Set olFldr = olNs.GetSharedDefaultFolder(olShareName, _
olFolderInbox).Folders("Sub_folder")
        Set olItems = olFldr.Items

    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder"  Then
        Set olFldr = olNs.GetSharedDefaultFolder(olShareName, _
olFolderInbox).Folders("Sub_Sub_Folder")
        Set olItems = olFldr.Items

    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Folder2"    Then
        Set olFldr = olNs.GetSharedDefaultFolder(olShareName, _
olFolderInbox).Folders("Sub_Sub_Folder2")
        Set olItems = olFldr.Items
    End If
End If

MsgBox ("You have " & olItems.Count & " mail in " & " the " & olFldr.Name & " 
folder"), vbInformation
    end sub
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.