Working with Email(outLook)

1. Saving email attachments to a predefined Folder:

Option Explicit
Const folderPath = "C:\Documents and Settings\kollol\My Documents\emailTest\"

Sub saveAttachments()
 On Error Resume Next
 Dim ns As NameSpace
 Set ns = GetNamespace("MAPI")
 Dim Inbox As MAPIFolder
 Set Inbox = ns.GetDefaultFolder(olFolderInbox)
 
 Dim searchFolder As String
 searchFolder = InputBox("What is your subfolder name?")

 Dim subFolder As MAPIFolder
 
 Dim Item As Object
 Dim Attach As Attachment
 Dim FileName As String
 Dim i As Integer



 If searchFolder <> "inbox" Then
 Set subFolder = Inbox.Folders(searchFolder)
            i = 0
            If subFolder.Items.Count = 0 Then
               MsgBox "There are no messages in the Inbox.", vbInformation, _
                      "Nothing Found"
               Exit Sub
            End If
                    For Each Item In subFolder.Items
                       For Each Attach In Item.Attachments
'
                         Attach.SaveAsFile (folderPath & Attach.FileName)
                         
                          i = i + 1
                       Next Attach
                    Next Item
                   
                    '==============================================================================
                    'to search specific type of file:
'                               'For Each Item In Inbox.Items
'                               For Each Atmt In Item.Attachments
'                                  If Right(Atmt.FileName, 3) = "xls" Then
'                                     FileName = "C:\Email Attachments\" & Atmt.FileName
'                                     Atmt.SaveAsFile FileName
'                                     i = i + 1
'                                  End If
'                               Next Atmt
'                            Next Item
                    '===============================================================================
                   
        Else
         i = 0
            If Inbox.Items.Count = 0 Then
               MsgBox "There are no messages in the Inbox.", vbInformation, _
                      "Nothing Found"
               Exit Sub
            End If
            On Error Resume Next
            For Each Item In Inbox.Items
               For Each Attach In Item.Attachments
                  FileName = folderPath & Attach.FileName
                  Attach.SaveAsFile FileName
                  i = i + 1
               Next Attach
            Next Item
     End If
   
End Sub