将Outlook文件夹中的所有电子邮件附件保存到Windows文件夹 [英] Save all email attachments in Outlook folder to Windows folder

问题描述

我大约有80封电子邮件，所有附件都希望将其保存到硬盘驱动器上的文件夹中。

I have about 80 emails, all with attachments which I would like to save to a folder on my hard drive.

如何使用脚本来完成？

How this can be done with a script?

推荐答案

在这里看看：从电子邮件项目（VBA）中保存和删除附件

Sub SaveAttachment()

    'Declaration
    Dim myItems, myItem, myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection

    'Ask for destination folder
    myOrt = InputBox("Destination", "Save Attachments", "C:\")

    On Error Resume Next

    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    'for all items do...
    For Each myItem In myOlSel

        'point on attachments
        Set myAttachments = myItem.Attachments

        'if there are some...
        If myAttachments.Count > 0 Then

            'add remark to message text
            myItem.Body = myItem.Body & vbCrLf & _
                "Removed Attachments:" & vbCrLf

            'for all attachments do...
            For i = 1 To myAttachments.Count

                'save them to destination
                myAttachments(i).SaveAsFile myOrt & _
                    myAttachments(i).DisplayName

                'add name and destination to message text
                myItem.Body = myItem.Body & _
                    "File: " & myOrt & _
                    myAttachments(i).DisplayName & vbCrLf

            Next i

            'for all attachments do...
            While myAttachments.Count > 0

                'remove it (use this method in Outlook XP)
                'myAttachments.Remove 1

                'remove it (use this method in Outlook 2000)
                myAttachments(1).Delete

            Wend

            'save item without attachments
            myItem.Save
        End If

    Next

    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing

End Sub

这篇关于将Outlook文件夹中的所有电子邮件附件保存到Windows文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！