Option Explicit

Sub getAttachments()

On Error GoTo error:

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim Filename As String
    Dim i As Integer

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0

    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the inbox.", vbInformation
        Exit Sub
    End If

    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            Filename = "C:\Documents and Settings\cunninb1\Desktop\Attachments\" & Atmt.Filename
            Atmt.SaveAsFile Filename
            i = i + 1
        Next Atmt
    Next Item

    If i > 0 Then
        MsgBox i & "attached files were found." & vbCrLf & _
            "They have been saved to C:\Documents and Settings\cunninb1\Desktop\Attachments\"
    Else
        MsgBox "No attachments were found."
    End If

GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

Exit Sub

'------------------------------------------------------
error:
Dim msgerr As Integer
msgerr = MsgBox("The following error occured during saving of attachments from Outlook." & vbCr & _
    "Error Description: " & Err.Description & vbCr & _
    "Error Number: " & Err.Number, vbOKOnly + vbInformation)

'------------------------------------------------------

End Sub