定位特定的Outlook邮件文件夹

时间:2018-04-16 16:19:21

标签: vba outlook-vba

我正在尝试创建一个Outlook宏来分析收件箱文件夹的主题,并决定将它们移动到subfolder的位置,或者根据四个不同类别的关键字列表删除它们。

问题是我使用的收件箱不是常规收件箱(我有两个不同的收件箱文件夹,而这个不是默认收件箱)。所以我需要以类似于编写完整路径(Example: "\\xxx@xxx.net\Inbox\")的方式来定位它。我试图找到答案,但我在这里找到的所有信息都与我们使用默认收件箱的假设有关。

Sub CountAttachmentsMulti2()
Dim oItem As Object
Dim iAttachments As Integer

For Each oItem In ActiveExplorer.Selection
    iAttachments = oItem.Attachments.Count + iAttachments

    If oItem.Attachments.Count <> 0 Then 'Si el mensaje contiene adjuntos
        NumofItems = oItem.Attachments.Count + NumofItems
        For j = 1 To oItem.Attachments.Count
            MsgBox oItem.Attachments.Item(j).DisplayName
            Value = oItem.Attachments.Item(j).DisplayName

            If InStr(LCase(Value), "su") > 0 Then
                MsgBox "Clap"
            End If

        Next j
    Else

        MsgBox oItem.Subject 'Get Subject Title
        NumofItems = NumofItems + 1
    End If

Next

MsgBox "Selected " & ActiveExplorer.Selection.Count & " messages with " & iAttachments & " attachements"

MsgBox "# of items = " & NumofItems
End Sub

这是我最初尝试过的代码,因为它们之前已经按类别分隔了。因此,所需要的只是按主题或附件数量计算总电子邮件数。

我现在的问题是我不知道如何使用完整路径定位此电子邮件帐户。

如果我知道如何定位该文件夹,我想我可以自己解决剩下的问题。

1 个答案:

答案 0 :(得分:0)

在遵循“可能重复”链接后,我能够完成我的代码。我道歉,因为我不知道它被称为参考。以下是我对该问题的完整解决方案:

Sub Test()

    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim Target_Folder As Outlook.MAPIFolder
    Dim oItem As Object
    Dim iAttachments As Integer

    Set objNS = GetNamespace("MAPI")
    Set objFolder_root = objNS.Folders("Testing") 'Getting Outlook Container
    Set objFolder = objFolder_root.Folders("Inbox") 'Target Inbox of the other container


    For Loops = objFolder.Items.Count To 1 Step -1
        Set oItem = objFolder.Items(Loops)
        If Category1(oItem.Subject) Then
            'MsgBox "Clap1"
            Set Target_Folder = objFolder_root.Folders("Category 1")
            oItem.Move Target_Folder
        ElseIf Category2(oItem.Subject) Then
            'MsgBox "Clap2"
            Set Target_Folder = objFolder_root.Folders("Category 2")
            oItem.Move Target_Folder
        ElseIf Category3(oItem.Subject) Then
            'MsgBox "Clap3"
            Set Target_Folder = objFolder_root.Folders("Category 3")
            oItem.Move Target_Folder
        ElseIf Category4(oItem.Subject) Then
            'MsgBox "Clap4"
            Set Target_Folder = objFolder_root.Folders("Category 4")
            oItem.Move Target_Folder
        Else
            MsgBox oItem.Subject & " does not belong to any of the 4 categories"
        End If

    Next

End Sub

Function Category1(value)
    Category_1_Keywords = Array("a")

    For i = 0 To UBound(Category_1_Keywords)
        If InStr(LCase(value), Category_1_Keywords(i)) > 0 Then
            Category1 = True
            Exit Function
        Else
            Category1 = False
        End If
    Next

End Function

当然,还有更多功能,我刚发布了Category1作为参考