Save attachment to outlook folder

Question

I have a number of emails from my previous email provider that I have forwarded to my Outlook 2010 inbox folder Received.

The problem I have is the original email has been sent as an attachment not as a forward! so what i would like to do is:

1. Open the mail in Received folder & run VBA code that will
2. Extract the attachment from the forwarded mail in the Received folder and save that attachment to Forwarded folder
3. Delete the forwarded mail in the Received folder.

I don't have an understanding of Outlook VBA code so I don't even have a starting point!

Any asssistance will be gratefully appreciated!

Answer 1

I use the Outlook Attachment Remover Add-In to remove attachments and save them in the file system. I use it mainly to reduce the space my profile needs on the server. One great thing is that the tool adds a link to the original attachment to the mail. So you still can open the attached file but it then opens from the file system.

Answer 2

Using my earlier code from VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment this Outlook VBA should do the trick.

Please ensure

• your folders Forwarded and Received do exist under the Inbox.

• The code requires a directory C:\temp\ to process the embedded emails

  Sub SaveOlAttachments()
  
  Dim olFolder As MAPIFolder
  Dim olFolder2 As MAPIFolder
  Dim msg As MailItem
  Dim msg2 As MailItem
  Dim strFilePath As String
  Dim strTmpMsg As String
  
  'path for creating attachment msg file for stripping
  strFilePath = "C:\temp\"
  strTmpMsg = "KillMe.msg"
  
  'My testing done in Outlok using a "temp" folder underneath Inbox
  Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  Set olFolder2 = olFolder.Folders("Forwarded")
  Set olFolder = olFolder.Folders("Received")
  
  For Each msg In olFolder.Items
      If msg.Attachments.Count > 0 Then
          If Right$(msg.Attachments(1).FileName, 3) = "msg" Then
              msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
              Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
          End If
          msg.Delete
          msg2.Move olFolder2
      End If
  Next
  End Sub