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

最新推荐文章于 2023-07-26 15:18:19 发布

Coding的巴扎黑

最新推荐文章于 2023-07-26 15:18:19 发布

阅读量5.1k

点赞数 4

分类专栏： VBA-Outlook 文章标签： vba outlook 邮件

本文链接：https://blog.csdn.net/zishendianxia/article/details/120917333

版权

VBA-Outlook 专栏收录该内容

6 篇文章

订阅专栏

系统：Windows 10
软件：Outlook 2016

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

Part 1：场景描述

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

Part 2：基本逻辑

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

收到一封新邮件
请添加图片描述

自动存储

请添加图片描述

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