用于将PDF附件移动到硬盘的Outlook宏

Sub MovePDFAttachments()
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Object
    Dim objAttachment As Outlook.Attachment
    Dim strFolderPath As String
    Dim strFileName As String
    
    ' 设置保存附件的文件夹路径
    strFolderPath = "C:\PDFAttachments\"
    
    ' 获取当前Outlook会话
    Set objNamespace = Application.GetNamespace("MAPI")
    
    ' 获取收件箱文件夹
    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    
    ' 遍历收件箱中的每个邮件
    For Each objItem In objFolder.Items
        ' 检查是否为邮件类型
        If objItem.Class = olMail Then
            ' 遍历邮件中的每个附件
            For Each objAttachment In objItem.Attachments
                ' 检查附件类型是否为PDF
                If Right(objAttachment.FileName, 4) = ".pdf" Then
                    ' 生成保存附件的文件路径
                    strFileName = strFolderPath & objAttachment.FileName
                    ' 保存附件到指定路径
                    objAttachment.SaveAsFile strFileName
                    ' 在控制台输出保存成功的消息
                    Debug.Print "Saved attachment: " & strFileName
                End If
            Next objAttachment
        End If
    Next objItem
    
    ' 释放对象
    Set objAttachment = Nothing
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objNamespace = Nothing
    
    ' 显示保存完成的消息框
    MsgBox "PDF attachments have been moved to the specified folder."
End Sub