时间戳

首页 > 解决方案 > 如果附件不是 PDF 或没有任何附件，则对电子邮件进行排序

vba - 如果附件不是 PDF 或没有任何附件，则对电子邮件进行排序

问题描述

我正在为 Outlook 编写 VBA 脚本，该脚本对电子邮件进行排序，因此收件箱中只有带有 PDF 文件的电子邮件。

我要感谢 Stackoverflow 中先前回答的问题，让这个 VBA 脚本工作并完成任务。

Sub MoveMail(Item As Outlook.MailItem)
    
If Item.Attachments.Count > 0 Then
    
    Dim attCount As Long
    Dim strFile As String
    Dim sFileType As String
    
    attCount = Item.Attachments.Count
    
    For i = attCount To 1 Step -1
        strFile = Item.Attachments.Item(i).FileName
          
        sFileType = LCase$(Right$(strFile, 4))
        
        Select Case sFileType
            Case ".txt", ".doc", "docx", ".xls", "xlsx"
            ' do something if the file types are found
            ' this code moves the message
            Item.Move (Session.GetDefaultFolder(olFolderInbox).Folders("Reply"))
         
            ' stop checking if a match is found and exit sub
            GoTo endsub
        End Select
    Next i
    
End If
     
endsub:
    
    Set Item = Nothing
     
End Sub

我还需要对没有附件的电子邮件进行排序。

如果附件不是 PDF 或没有任何附件，我如何检查电子邮件，然后将其移动到 Outlook 中名为回复的文件夹？

标签： vbasortingoutlookemail-attachmentsinbox

解决方案

在将带有指定附件的电子邮件从共享收件箱移动到同一共享邮箱的不同文件夹中找到使用的解决方案

它回答了我的问题，并为我提供了为我自己的问题找到解决方案所需的信息，并使创建此脚本成为可能

Sub MoveMail(Item As Outlook.MailItem)

    Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

    Dim myAtt As Outlook.Attachment
    Dim allPdf As Boolean
    Dim hidNum As Integer
    allPdf = True
    hidNum = 0
    Dim pa As PropertyAccessor

    For Each myAtt In Item.Attachments
        Debug.Print myAtt.DisplayName
        Set pa = myAtt.PropertyAccessor

        If pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
            hidNum = hidNum + 1
        Else
            If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) And Right(LCase(myAtt.FileName), 4) <> ".pdf" Then
                allPdf = False
            End If
        End If
    Next

    If allPdf = False Or Item.Attachments.Count = hidNum Then
        Item.Move (Session.GetDefaultFolder(olFolderInbox).Folders("Reply"))
    End If

    Set myAtt = Nothing
    Set pa = Nothing

End Sub

推荐阅读