如果附件是 PDF 以外的其他附件或没有任何附件，则对电子邮件进行排序

Question

我正在为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中名为"回复"的文件夹中？

Answer 1

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

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

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