VBA自动下载Outlook指定文件的邮件附件

自己之前写的一个从Outlook指定文件夹自动下载邮件附件的代码，T日下载T-1日的邮件附件，进攻大家参考，代码为个人原创。
使用之前需要设置Outlook创建规则，将指满足条件的邮件自动移到指定文件夹，然后该代码从指定文件夹下载。

'使用前准备，前期绑定，点击工具-引用-Microsoft Outlook 16.0 Object Library 勾选
'该方式需要结合Outlook创建规则使用，先用规则把对应的邮件移动到收件箱下面的文件
'下面的代码就是从收件箱下指定的文件中下载全部邮件对象的附件并保存到指定位置
'如果想不报错，请重新修改mypath的路径；f1.name下载附件的账户；f3.name指定"收件箱"下文件夹的名字
'如果层级更多，可以再嵌套

Sub 下载附件()
Dim myoutlook As Outlook.Application
Dim namespace As Outlook.namespace
Dim mypath As String
Dim f1 As folder
Dim f2 As folder
Dim f3 As folder
Dim mymail As mailitem '声明为一个邮件
Dim myatts As Attachment '声明为一个附件
 
mypath = "D:\Power BI\下载\" '""中填写需要保存的附件的本地地址，最后面以“\”结尾，例如："C:\桌面\"
Set myoutlook = CreateObject("outlook.Application") '特定用法
Set namespace = myoutlook.GetNamespace("MAPI") '特定用法
For Each f1 In namespace.Folders '邮箱账户集合，如果是登陆多个账户的可以循环账户
    If f1.Name = "你自己的邮箱@meicai.cn" Then '如果同时登陆多个账户，这步可以指定账户
        For Each f2 In f1.Folders '二级文件夹集合，某个账户下收件箱这一层级的文件集合
            If f2.Name = "下载" Then '指定只循环“收件箱”
                For Each mymail In f2.Items 'f2.items是一个邮件对象
                    If DateValue(mymail.CreationTime) = Date Then '每次只下载最新一天的数据
                    '(DateValue(mymail.CreationTime) = Date - 1 And Hour(mymail.CreationTime) >= 8 And mymail.Subject = "星罗数据订阅-宽进严出项目加强分拣费收入")
                        For Each myatts In mymail.Attachments '循环邮件的附件
                            myatts.SaveAsFile mypath & Mid(mymail, 8, 50) & ".xlsx" '按照邮件主题修改附件表名
                            '附件的操作方法，另存为并保存到指定路径，使用附件的文件名进行保存
                        Next
                    End If
                Next
            End If
        Next
    End If
Next
End Sub