☰

如何通过提取邮件项目将 Outlook 中的多个 PDF 附件保存到硬盘

tag-icon • tag-icon email microsoft-outlook microsoft-office vba microsoft-outlook-2010
如何通过提取邮件项目将 Outlook 中的多个 PDF 附件保存到硬盘

我有 25 封邮件，每封邮件中都有 25 个 pdf 附件，这些附件都位于一封邮件中 - 相互层叠。换句话说，一封邮件包含 25 个 Outlook 邮件项目，每个邮件附加 1 个 pdf。我找到了一个代码来保存所有附件，但当我这样做时，它只会将它们保存为 Outlook 邮件项目。我需要从 Outlook 邮件项目中提取 pdf。有任何已知的 VBA 代码吗？？？- 请记住，我无法安装需要管理员权限的软件，因为这是一台工作电脑。所以，如果您要我安装第三方软件，除非它们是压缩文件或 Windows Outlook 插件，如 VBA 代码等，否则我将无法安装它们。

示例图像

欲了解更多信息，请参阅此图片

答案1

保存 Outlook 项目后，您可以使用 OpenSharedItem 打开它

https://msdn.microsoft.com/EN-US/library/office/ff869733.aspx

然后保存 PDF 附件。

如果您已经有保存邮件项的代码，那么在保存每个邮件项之后立即插入 OpenSharedItem 以及保存 PDF 的代码。

以下示例代码演示了如何使用 OpenSharedItem 将邮件从 Windows 带回 Outlook。https://www.slipstick.com/developer/code-samples/move-messages-file-system-outlook/

Sub ImportMessagesInFolder()
    Dim fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SourceFolderName As String
    Dim FileItem As Scripting.File
    Dim strFile, strFileType As String
    Dim oMsg As Object
    Dim copiedMsg As MailItem
    Dim Savefolder As Outlook.Folder

    Set fso = New Scripting.FileSystemObject
'Source folder
    SourceFolderName = "C:\Users\drcp\Documents\Email\"
    Set SourceFolder = fso.GetFolder(SourceFolderName)

'Set the Outlook folder name
    ' Set Savefolder = Session.GetDefaultFolder(olFolderInbox).Folders("My Subfolder")
    Set Savefolder = Application.ActiveExplorer.CurrentFolder

    For Each FileItem In SourceFolder.Files

    Set oMsg = Session.OpenSharedItem(FileItem.Path)

    ' Do not bypass errors indiscriminately
    'On Error Resume Next

    Set copiedMsg = oMsg.Copy
    copiedMsg.Move Savefolder

    Set copiedMsg = Nothing
    oMsg.Delete
    Set oMsg = Nothing

    Next FileItem

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set fso = Nothing

End Sub

答案2

您可以使用两个免费的实用程序来实现这一点。

第一的，保存附加的 Outlook 项目。只需在 Outlook 中创建一个临时文件夹（例如“附件”），在 Outlook 中选择这 25 条消息，然后使用上下文菜单运行上述工具，指定“附件”文件夹作为目标文件夹。现在，您的所有附加电子邮件（带有 PDF）都位于临时“附件”文件夹中。

最后，使用保存附件实用程序，选择“附加”文件夹并指定磁盘上的目标文件夹。这会将所有 PDF 保存到指定的文件夹中。

请注意，我推荐这些工具是因为我是开发人员之一，所以如果您有任何其他问题，请随时提出。

答案3

好的，我明白了。首先，您需要在收件箱中创建一个新文件夹。然后，将所有电子邮件项目复制到您的新文件夹中（25 个 Outlook 电子邮件项目，其中包含 25 个 pdf）。然后突出显示所有电子邮件，然后运行以下脚本。这将允许您保存所有电子邮件。

Sub ImportMessagesInFolder()
Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SourceFolderName As String
Dim FileItem As Scripting.File
Dim strFile, strFileType As String
Dim oMsg As Object
Dim copiedMsg As MailItem
Dim Savefolder As Outlook.Folder

Set fso = New Scripting.FileSystemObject
'Source folder
SourceFolderName = "C:\Users\drcp\Documents\Email\"
Set SourceFolder = fso.GetFolder(SourceFolderName)

 'Set the Outlook folder name
' Set Savefolder = Session.GetDefaultFolder(olFolderInbox).Folders("My Subfolder")
Set Savefolder = Application.ActiveExplorer.CurrentFolder

For Each FileItem In SourceFolder.Files

Set oMsg = Session.OpenSharedItem(FileItem.Path)

' Do not bypass errors indiscriminately
'On Error Resume Next

Set copiedMsg = oMsg.Copy
copiedMsg.Move Savefolder

Set copiedMsg = Nothing
oMsg.Delete
Set oMsg = Nothing

Next FileItem

Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing

End Sub

相关内容