Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim pobjMsg As Outlook.MailItem 'Object
    Dim objSelection As Outlook.Selection

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

    For Each pobjMsg In objSelection
        SaveAttachments_Parameter pobjMsg
    Next

ExitSub:

    Set pobjMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

Public Sub SaveAttachments_Parameter(objMsg As MailItem)
    Dim objAttachments As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "OLAttachments"

        ' Get the Attachments collection of the item.
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count

        If lngCount > 0 Then

            ' We need to use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.
            For i = lngCount To 1 Step -1

                ' Save attachment before deleting from item.
                ' Get the file name.
                strFile = objAttachments.Item(i).FileName

                ' Combine with the path to the Temp folder.
                strFile = strFolderpath & strFile

                ' Save the attachment as a file.
                objAttachments.Item(i).SaveAsFile strFile

                ' Delete the attachment.
                'objAttachments.Item(i).Delete

                'write the save as path to a string to add to the message
                'check for html and use html tags in link
                If objMsg.BodyFormat  olFormatHTML Then
                   strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & strFile & "'>" & strFile & "</a>"
                  Else
                   strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
                End If
            Next i
        End If

        ' Adds the filename string to the message body and save it [COMMENTED AS THIS FUNCTION WAS NOT DESIRED]
        ' Check for HTML body
        '        If objMsg.BodyFormat  olFormatHTML Then
        '            objMsg.Body = objMsg.Body & vbCrLf & _
        '            "The file(s) were saved to " & strDeletedFiles
        '        Else
        '            objMsg.HTMLBody = objMsg.HTMLBody & "" & _
        '            "The file(s) were saved to " & strDeletedFiles & ""
        '        End If
        objMsg.Save
ExitSub:

    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objOL = Nothing
End Sub