时间戳

首页 > 解决方案 > 如何从 Outlook 中提取 PDF 附件并保存到文件夹

vba - 如何从 Outlook 中提取 PDF 附件并保存到文件夹

问题描述

我需要在 Outlook 中使用 VBA 代码来从电子邮件中提取 PDF 附件并保存到指定的文件夹中。用户将选择电子邮件。

我有以下代码，但需要对其进行修改。

Public Sub SaveAutoAttach(item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment

Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "D:\Data\Archive"

    For Each object_attachment In item.Attachments
' Criteria to save .doc files only
    If InStr(object_attachment.DisplayName, ".doc") Then

        object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName

    End If

    Next


End Sub

标签： vbaoutlook

解决方案

根据您的要求，以下宏将保存来自一个或多个用户选定项目的任何 PDF 附件。

Option Explicit

Sub SaveAttachmentsFromSelectedItemsPDF()

    Dim currentItem As Object
    Dim currentAttachment As Attachment
    Dim saveToFolder As String
    Dim savedFileCountPDF As Long

    saveToFolder = "c:\users\domenic\desktop" 'change the path accordingly

    savedFileCountPDF = 0
    For Each currentItem In Application.ActiveExplorer.Selection
        For Each currentAttachment In currentItem.Attachments
            If UCase(Right(currentAttachment.DisplayName, 4)) = ".PDF" Then
                currentAttachment.SaveAsFile saveToFolder & "\" & _
                    Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".pdf"
                savedFileCountPDF = savedFileCountPDF + 1
            End If
        Next currentAttachment
    Next currentItem

    MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation

End Sub

推荐阅读