系统：Windows 10
软件：Outlook 2016

• 本系列讲讲在Outlook中使用VBA实现一些功能
• 今天讲讲对收件箱中附件进行处理

Part 1：目的

1. 对收件箱进行遍历，若邮件还有附件，将其附件保存到本地

收件箱

附件保存

Part 2：代码

Sub test2()
    Dim outlookItem As Object
    Dim outlookMail As MailItem
    Dim outlookFldr As Folder
    Dim outlookName As NameSpace
    Dim oLoolAtt As Attachment
    
    Set outlookName = Application.GetNamespace("MAPI")
    Set outlookFldr = outlookName.GetDefaultFolder(olFolderInbox)
    
    i = 1
    For Each outlookItem In outlookFldr.Items
        Debug.Print ("主题是：" & outlookItem.Subject)
        attachmentsCount = outlookItem.Attachments.Count
        Debug.Print ("附件数目为：" & attachmentsCount)
        
        If attachmentsCount > 0 Then
            For Each Attachment In outlookItem.Attachments
                attachmentFileName = Attachment.FileName
                Debug.Print ("附件名称为：" & attachmentFileName)
                
                newFileAddress = "D:\233N\233N_1_2个公众号\2-VBA\【3】文章\Outlook\20210731-outlook-03-附件处理1-收附件\附件" & "\" & attachmentFileName
                If Dir(newFileAddress) <> "" Then
                    Debug.Print ("文件已存在，将删除后保存")
                    Kill newFileAddress
                End If
                Attachment.SaveAsFile (newFileAddress)
            Next

        End If
        
        Debug.Print (Chr(10))

        i = i + 1
    Next

End Sub

代码截图

立即窗口

Part 3：部分代码解读

1. attachmentsCount = outlookItem.Attachments.Count获取邮件的附件数目
2. For Each Attachment In outlookItem.Attachments，对附件进行遍历
3. attachmentFileName = Attachment.FileName获取附件的名称
4. Attachment.SaveAsFile (newFileAddress)将附件另存到本地
   • 注意当拟存储的文件在本地已经存在，需要先删除之前的文件，确保附件成功保存
   • 不删除之前已经存在的文件的话，测试了一下，有些会替代，有些不会，不知道啥情况。所以建议先删除之前的文件，确保没有问题

---

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

---

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