如何从Outlook指定发件人邮件及非默认收件箱提取PDF文件

问题1：指定非默认收件箱的正确配置 #

• 你原来的Set Inbox = olNs.GetDefaultFolder (onothermail@gmail.com)写法错误，GetDefaultFolder方法仅能传入枚举值获取当前默认账号的对应文件夹，无法直接传入邮箱地址。
• 两种常用的非默认收件箱引用方式：
  1. 共享邮箱场景（你现有代码的场景）：GetSharedDefaultFolder方法必须补充第二个参数指定文件夹类型为收件箱，且需要先校验收件人解析成功，示例：

  Set objOwner = olNs.CreateRecipient("secondMail@gmail.com")
  objOwner.Resolve ' 必须解析收件人
  If objOwner.Resolved Then
      ' 补充olFolderInbox参数指定为收件箱
      Set Inbox = olNs.GetSharedDefaultFolder(objOwner, olFolderInbox)
  End If
  

  2. 本地已配置的多个自有邮箱场景：直接遍历账号文件夹获取，更简单不易出错：

  ' 直接按邮箱地址找到对应账号的收件箱
  Set Inbox = olNs.Folders("secondMail@gmail.com").Folders("收件箱")
  

问题2：提取特定发件人邮件的PDF附件优化 #

你现有代码存在以下可调整点：

• 附件类型判断中多余保留了jpg、zip的判断，可删除仅保留pdf格式校验
• 用LCase函数统一转小写后判断，无需分别校验大小写后缀
• 标记邮件为已读的代码放在附件循环内，存在重复执行的问题，需移到附件循环外层
• 保存路径拼接避免重复生成双斜杠，你的FilePath变量末尾已经带斜杠，不需要额外再加\

修正后完整代码 #

Option Explicit
Public Sub ExtractPdfFromSpecificSender()
   '// 声明变量
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Item As Outlook.MailItem
    Dim Atmt As Attachment
    Dim Filter As String
    Dim FilePath As String
    Dim i As Long
    Dim objOwner As Outlook.Recipient

   '// 设置收件箱引用
    Set olNs = Application.GetNamespace("MAPI")
    
    ' --- 二选一使用对应收件箱获取方式 ---
    ' 方式1：共享邮箱
    Set objOwner = olNs.CreateRecipient("secondMail@gmail.com")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set Inbox = olNs.GetSharedDefaultFolder(objOwner, olFolderInbox)
    End If
    ' 方式2：自有多邮箱，注释上面方式1的代码，取消下面注释即可
    ' Set Inbox = olNs.Folders("secondMail@gmail.com").Folders("收件箱")
    ' ----------------------------------
    
    FilePath = "C:\Users\Unity\Desktop\adjuntos\"
    
    ' 过滤未读邮件
    Filter = "[Unread] = True"
    Set Items = Inbox.Items.Restrict(Filter)

   '// 倒序遍历邮件避免索引错乱
    For i = Items.Count To 1 Step -1
        DoEvents
        If Items(i).Class = olMail Then
            Set Item = Items(i)
            ' 匹配指定发件人
            If Item.SenderEmailAddress = "senderx@gmail.com" Then
                ' 遍历附件提取PDF
                For Each Atmt In Item.Attachments
                    If LCase(Right(Atmt.DisplayName, 4)) = ".pdf" Then
                        Atmt.SaveAsFile FilePath & Atmt.DisplayName
                    End If
                Next Atmt
                ' 处理完成标记为已读
                Item.UnRead = False
            End If
        End If
    Next i

    ' 释放对象
    Set Inbox = Nothing
    Set Items = Nothing
    Set Item = Nothing
    Set Atmt = Nothing
    Set olNs = Nothing
End Sub

内容的提问来源于stack exchange，提问作者Lynx