如何用vba遍历outlook收件箱中的邮件并另存所有的附件？

在outlook中数据都是存放在具体的文件夹内的，文件夹之间具有层级关系。

收件箱就属于一个文件夹，可以使用NameSpace对象的GetDefaultFolder方法直接获得默认的文件夹对象Folder，如收件箱文件夹，发件箱文件夹对象等。

所有文件夹下的邮件构成了Items集合对象。

以下vba代码举例示范了如何用vba遍历收件箱中的所有邮件，并将邮件的附件另存在本地电脑上：

Sub QQ1722187970()
     Dim sPath As String
    sPath = Excel.ThisWorkbook.Path & "\"
    Dim objAccount As Outlook.Account
    Dim objOutlookApp As Outlook.Application
    Set objOutlookApp = New Outlook.Application
    Dim objNamespace As Outlook.Namespace
    Dim objFolder As Outlook.Folder
    Dim objItems As Outlook.Items
     '邮件附件对象
    Dim objAttachment As Outlook.Attachment
    With objOutlookApp
        Set objNamespace = .Session
        '与Session属性一样的效果
        Set objNamespace = .GetNamespace("MAPI")
        With objNamespace
            '获取收件箱文件夹
            Set objFolder = .GetDefaultFolder(olFolderInbox)
            With objFolder
                Dim objMailItem As Outlook.MailItem
                '遍历每个邮件
                For i = 1 To .Items.Count
                    Set objMailItem = .Items(i)
                    With objMailItem
                        '输出每个邮件的主题
                        strSubject = .Subject
                        '输出每个邮件的创建时间
                        dateCreationTime = .CreationTime
                        For Each objAttachment In .Attachments
                            With objAttachment
                                '附件的名称
                                sName = .DisplayName
                                '将附件另存到本地
                                .SaveAsFile sPath & sName
                            End With
                        Next
'                        .Display
                    End With
                Next i
            End With
        End With
    End With
End Sub