Need help on Writing Macros to open email, save attachment and then close email in OL2002

I hope someone can help as i am getting very frustrated.  I am new to VBA and i need to write a macro which will open up an email, save the attachment to a folder in My C drive and then close the email and return me back to my Inbox.  I have managed to do the middle part using the following code: Taken from the VBA help which i run afteri doubleclick on the email it then saves the attachment in my C Drive.  Which is great.  

Sub Saveattachements()
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
myAttachments.Item(1).SaveAsFile "C:\" & _
    myAttachments.Item(1).DisplayName
myItem.Close
    End Sub

But what i need is to be able to do click on it so that it opens saves the attachment and then closes the email.  Have you any ideas as i don't seem to be getting anywhere.

I hope i have explained it clearly.

Matt
NobbyGeeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

stefriCommented:
just use the selection
Sub Saveattachements()
dim theSel as Outlook.Selection

set theSel = application.activeexplorer.selection
if theSel.count = 0 then

else
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
myAttachments.Item(1).SaveAsFile "C:\" & _
    myAttachments.Item(1).DisplayName
myItem.Close
    End Sub
0
stefriCommented:
oops. wrong key....
just use the selection object from Application

Sub Saveattachements()
dim theSel as Outlook.Selection
   
                set theSel = application.activeexplorer.selection
      if theSel.count = 0 then
          exit sub
      else
          for each itm in theSel
             Set myAttachments = itm.Attachments
                 for each att in myAttachments
                     att.SaveAsFile "C:\" &   att.DisplayName
                           next
                 set att = nothing
                 itm.close
          next
          set itm = nothing
          set theSel = nothing
      end if
    End Sub

Select a mail or a group of mails, then select the macro from Tools/Macros/Run or create a button, assign SaveAttachments sub to the button

Tools/Macros/Secutiry must be set to Medium
Stefri
0
NobbyGeeAuthor Commented:
That was perfect the only problem i had was that it did not like the itm.close - I crossed that out and it works. Before i accept your answer which i will and give you an A - Any reason why it did this and what was the itm.close - All i did was highlight the email - did not need to open it and it saved into C.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

NobbyGeeAuthor Commented:
Another quick question can you rename your Macro Button that i have placed on my Standard toolbar as it reads Doc Image.save attachments?
0
stefriCommented:
You are right, itm.close is not necessary as the item is not opened/modified (my fault, customizing an existing code), so comment it out
Rename the macro whatever you want as long as the button references it
You can also create/assign an icon to the macro button

Stefri
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
NobbyGeeAuthor Commented:
That is brilliant thanks for all your help!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.