Sub SaveAttachments_ReceivedMail(item As mailItem)
Dim ItemAttachment As Object
Dim StrFolderPath As String
Dim strFileName As String
Dim ItemsAttachmentsCount As Long
Dim iSave As Long
Dim msg As String
StrFolderPath = "C:\test\"
If (Dir$(StrFolderPath, vbDirectory) = "") Then
    Debug.Print "'" & StrFolderPath & "' not exist"
    MkDir StrFolderPath
    Debug.Print "'" & StrFolderPath & "' we create it"
Else
    Debug.Print "'" & StrFolderPath & "' exist"
End If
If Right(StrFolderPath, 1) <> "\" Then
   StrFolderPath = StrFolderPath & "\"
End If
ItemsAttachmentsCount = 0
 
    If TypeOf item Is mailItem Then
 
        For Each ItemAttachment In item.Attachments
            ItemsAttachmentsCount = ItemsAttachmentsCount + 1
            ' Get the file name.
            strFileName = ItemAttachment.FileName
            ' Combine with the path to the Attachments folder.
            strFileName = StrFolderPath & ItemsAttachmentsCount & "_" & strFileName
            ' Save the attachment as a file.
            ItemAttachment.SaveAsFile strFileName
        Next ItemAttachment
 
    End If
 
ExitSub:
Set item = Nothing
msg = "All Selected Folder Attachments Have Been Saved to " & StrFolderPath & vbCr & vbCr
msg = msg & "ItemsAttachmentsCount : " & ItemsAttachmentsCount
Debug.Print msg
End Sub