Saving Outlook E-mail Attachments To a Folder

I was looking for some code samples as I wanted to save e-mail attachments to a folder. Below is the code I got from OutlookCode.com. I modified it a bit as I did not want to touch the original e-mails...

In Outlook, hit Alt+F11, double click modules and paste it into module1

Sub SaveSelectedAttachment()

  '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:\Entertainment\Attachments\")

  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

I have also seen a lot of useful code examples here