使用Outlook VBA自动保存传入的电子邮件附件

Question

我在“ ThisOutlookSession”项目中有以下代码，但做错了一点，因为它不保存带有pdf附件的传入电子邮件。

Public WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewMail As Outlook.MailItem
    Dim Atts As Attachments
    Dim Att As Attachment
    Dim strPath As String
    Dim strName As String

    If Item.Class = olMail Then
       Set NewMail = Item
    End If

    Set Atts = Item.Attachments

    If Atts.Count > 0 Then
       For Each Att In Atts
           'word I want to look for in attachment name
           If InStr(LCase(Att.FileName), "pdf") > 0 Then
              'destination folder path to save the attachments
              strPath = "C:\Attachments"
              strName = NewMail.Subject & " " & Chr(45) & " " & Att.FileName
              Att.SaveAsFile strPath & strName
           End If
       Next
    End If
End Sub