Outlook-VBA-05-自动获取邮件附件

系统：Windows 10
软件：Outlook 2016

• 本系列讲讲在Outlook中使用VBA实现一些功能
• 今天讲讲如何将特定人员，特定主题的邮件的附件存储到本地

Part 1：场景描述

1. 工作中，希望另外一方定期给自己分发一些报告，在本地写了一个自动处理报告的程序。
   • 对方可以写一个程序，自动发送邮件
   • 而我们需要定期获取对方发过来的报告，有很多种方式，如ftp，假设只能采用邮箱的这种方式

Part 2：基本逻辑

1. 设置一个事件，收到新邮件则触发
2. 获取新邮件的发件人邮箱，主题信息，以及是否有附件
3. 满足条件后，将附件存储到本地

收到一封新邮件

自动存储

Part 3：代码

Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
    Dim outlookFldr As Folder
    Dim outlookName As NameSpace

    Set outlookName = Application.GetNamespace("MAPI")
    Set outlookFldr = outlookName.GetDefaultFolder(olFolderInbox)
    Set Items = outlookFldr.Items
End Sub


Private Sub Items_ItemAdd(ByVal Item As Object)
    '邮件主题
    Debug.Print ("新收到的邮件主题是：" & Item.Subject)
    MsgBox "新收到的邮件主题是：" & Item.Subject
    subject_info = Item.Subject
    
    '发件人
    Debug.Print ("新收到的邮件发件人是：" & Item.SenderName)
    Debug.Print ("新收到的邮件发件人是：" & Item.SenderEmailAddress)
    send_person = Item.SenderEmailAddress
    
    '附件
    attachmentsCount = Item.Attachments.Count
    Debug.Print ("附件数目为：" & attachmentsCount)
    
    If InStr(subject_info, "广东") <> 0 And send_person = "XXX@163.com" And attachmentsCount > 0 Then
        For Each Attachment In Item.Attachments
                attachmentFileName = Attachment.FileName
                Debug.Print ("附件名称为：" & attachmentFileName)
                
                newFileAddress = "D:\xxx\【3】文章\Outlook\20211023-outlook-05-多条件处理" & "\" & attachmentFileName
                If Dir(newFileAddress) <> "" Then
                    Debug.Print ("文件已存在，将删除后保存")
                    Kill newFileAddress
                End If
                Attachment.SaveAsFile (newFileAddress)
            Next
    End If
End Sub

代码截图

Part 4：部分代码解读

1. subject_info = Item.Subject获取邮件主题
2. send_person = Item.SenderEmailAddress获取发件人的邮箱
3. Item.Attachments.Count获取附件的数目
4. InStr(subject_info, "广东") <> 0可以用来判断是否包括某字符串
5. 关于事件功能，文件另存为，之前文章有所讲述

• 更多学习交流，可加小编微信号learningBin

更多精彩，请关注微信公众号
扫描二维码，关注本公众号