Question

我希望使某些电子邮件归档自动化，而我遇到的一件事是，例如，当首先找到“ .dwg”文件并且还附加了“ .jpg”时，它仅进行分类我通过“本机文件”发送的电子邮件，也未将其归类为“照片”。

    Dim olkAtt As Outlook.Attachment
    'Check each attachment
    For Each olkAtt In item.Attachments
        'If the attachments file name ends with .dwg
        If Right(LCase(olkAtt.FileName), 4) = ".dwg" Then
            'Categorize email
            item.Categories = "Native Files"
            item.Save

        'If the attachments file name ends with .dxf
        ElseIf Right(LCase(olkAtt.FileName), 4) = ".dxf" Then
            'Categorize email
            item.Categories = "Native Files"
            item.Save

        'If the attachments file name ends with .jpg
        ElseIf Right(LCase(olkAtt.FileName), 4) = ".jpg" Then
            'Categorize email
            item.Categories = "Photos"
            item.Save

        'If the attachments file name ends with .xlsx
        ElseIf Right(LCase(olkAtt.FileName), 5) = ".xlsx" Then
            'Categorize email
            item.Categories = "Native Files"
            item.Save

        ElseIf InStr(0, LCase(olkAtt.FileName), "RFI") <> 0 Then
            'Categorize email
            item.Categories = "RFI/DCN/FCN"
            item.Save

            End If
    Exit For
    Next
    Set olkAtt = Nothing
End Sub

我认为这会查看每个附件，通过if语句运行，然后将每个附件的电子邮件分类（如果文件有多种情况，我希望电子邮件具有多个类别）。

感谢您的帮助。

编辑：

在蒂姆的帮助下，这是更新的代码：

Sub Categorize_Emails(item As Outlook.MailItem)
    Dim olkAtt As Outlook.Attachment, attName As String
    'Check each attachment
    For Each olkAtt In item.Attachments

    attName = LCase(olkAtt.FileName)
        'If the attachment is an RFI or DCN or FCN
        If InStr(LCase(attName), "rfi") <> 0 Or InStr(LCase(attName), "dcn") <> 0 Or InStr(LCase(attName), "fcn") <> 0 Then
            'Categorize email
            AddCategory item, "RFI/DCN/FCN"

        'If the attachments file name ends with .jpg
        ElseIf Right(LCase(olkAtt.FileName), 4) = ".jpg" Then
            'Categorize email
            AddCategory item, "Photos"

        'If the attachments file name ends with .dwg or .dxf or .xlsx
        ElseIf Right(LCase(olkAtt.FileName), 4) = ".dwg" Or Right(LCase(olkAtt.FileName), 4) = ".dxf" Or Right(LCase(olkAtt.FileName), 5) = ".xlsx" Then
            'Categorize email
            AddCategory item, "Native Files"

            End If

    Next olkAtt
    Set olkAtt = Nothing
End Sub


'add a category to an item if it doesn't already exist
Sub AddCategory(itm, cat)
    Const SEP As String = ";"
    Dim c, bExists As Boolean
    If Len(itm.Categories) = 0 Then
        itm.Categories = cat
        itm.Save
    Else
        arr = Split(itm.Categories, SEP)
        For Each c In arr
            If c = cat Then
                bExists = True
                Exit For
            End If
        Next c
        If Not bExists Then
            itm.Categories = Join(arr, SEP) & SEP & cat 'add if not present
            itm.Save
        End If
    End If
End Sub

Answer 1

https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem.categories

Categories是已分隔的类别名称的分隔字符串。分配给Outlook项目。该属性使用字符在HKEY_CURRENT_USER \ Control下的值名称sList中指定 Windows注册表中的Panel \ International，作为分隔符多个类别。将类别名称的字符串转换为类别名称的数组，请使用Microsoft Visual Basic函数Split

像这样（未经测试）：

Sub Tester()

    Dim olkAtt As Outlook.Attachment, attName As String

    '...
    '...

    'Check each attachment
    For Each olkAtt In Item.Attachments

        attName = LCase(olkAtt.Filename)

        If Right(attName, 4) = ".dwg" Or Right(attName, 4) = ".dxf" Or _
           Right(attName, 5) = ".xlsx" Then

           AddCategory Item, "Native Files"
        ElseIf Right(attName, 4) = ".jpg" Then
            AddCategory Item, "Photos"
        ElseIf InStr(0, attName, "RFI") <> 0 Then
            AddCategory Item, "RFI/DCN/FCN"
        End If
        'Exit For  '???
    Next
    Set olkAtt = Nothing
End Sub

'add a category to an item if it doesn't already exist
Sub AddCategory(itm, cat)
    Const SEP As String = ","
    Dim c, bExists As Boolean
    If Len(itm.Categories) = 0 Then
        itm.Categories = cat
        itm.Save
    Else
        arr = Split(itm.Categories, SEP)
        For Each c In arr
            If c = cat Then
                bExists = True
                Exit For
            End If
        Next c
        If Not bExists Then
            itm.Categories = Join(arr, SEP) & SEP & cat 'add if not present
            itm.Save
        End If
    End If
End Sub

如何对不同文件类型或条件的多个附件进行分类

1 个答案: