Saving Outlook Attachements

[jdevan]

Hi
I have seen some VBA code for saving attachments into a folder from incoming emails. Could anybody guide me to do this one attachment at a time ? I should be able to trigger a macro which should save the attachment in the "open" email as I am reading it - into a folder I have already created C:\attachments. And then, the macro should leave a hyperlink in the email so that the next time I open the email - I can click and view the attachment.

Most code available are to scan through the entire Inbox and save them enmass. I am using Outlook 2010.

I am sorry for posting it here as this is an excel forum; but I cant find as good a forum as Mrexcel to post an Outlook question.

 

[JP2112]

Something like this:

Sub SaveAttachments()
  Dim currentItem As Object
  Dim attachs As Outlook.Attachments
  Dim i As Long
 
  Set currentItem = GetCurrentItem
  If TypeName(currentItem) = "MailItem" Then
    Set attachs = currentItem.Attachments
    ' loop backwards because we are removing attachments
    For i = attachs.Count To 1 Step -1
      attachs.Item(i).SaveAsFile "C:\attachments\" & attachs.Item(i).Filename
      attachs.Item(i).Delete
      ' update message body with hyperlink to file
 
      currentItem.Body = currentItem.Body & vbNewLine & "< file://C:\attachments\" & attachs.Item(i).Filename & ">"     
    Next i
  End If  
End Sub
 
Function GetCurrentItem() As Object
' returns reference to current item, either the one
' selected (Explorer), or the one currently open (Inspector)
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.Item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function

This is air code so please step through it to make sure it does what you want.

 

[JP2112]

You'll need to remove the space between "<" and "file" in the code above -- when I posted it as-is, the code was removed by the text editor.