Save all email attachments in Outlook folder to Windows folder

Question

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?

Answer 1

Take a look here: Save and remove attachments from email items (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