Boa tarde!!

Leia:
http://www.rondebruin.nl/win/s1/outlook/saveatt.htm

Att

Boa tarde!!

Tente adaptar...
Fonte:
http://stackoverflow.com/

Public Sub Teste()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Obter o caminho para a pasta Meus Documentos
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
' Instanciar um objeto Application Outlook.
Set objOL = CreateObject("Outlook.Application")
' Obter a coleção de objetos selecionados.
Set objSelection = objOL.ActiveExplorer.Selection

'Definir a pasta de anexos .
strFolderpath = strFolderpath & "Attachments"
' Verifique cada item selecionado para anexos. Se houver anexos ,
' Salvá-los para a pasta strFolderPath e tira -los do item.
For Each objMsg In objSelection
' Este código só retira anexos de itens de correio .
' Obter a coleção de anexos do item.
' A partir de uma coleção. Caso contrário, o contador de loop recebe
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""

If lngCount > 0 Then
     ' Salve penhora antes da exclusão do item.
     ' Salve o anexo como um arquivo .
     'Eliminar o anexo.
For i = lngCount To 1 Step -1

    ' escrever o salvar como caminho para uma string para adicionar à mensagem
     'Verifi o html e usar tags HTML em ligação
   
    strFile = objAttachments.Item(i).Filename

    ' Use o comando MsgBox para solucionar problemas. Removê-lo a partir do código final.
    
    strFile = strFolderpath & strFile

    ' MsgBox strDeletedFiles

   ' Adiciona a string nome do arquivo para o corpo da mensagem e guardá-lo
   'Verificar corpo HTML
    objAttachments.Item(i).SaveAsFile strFile

    ' Deleta o anexo
    objAttachments.Item(i).Delete

    
    If objMsg.BodyFormat <> olFormatHTML Then
        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
        Else
        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
        strFile & "'>" & strFile & "</a>"
    End If

    'escrever o salvar como caminho para uma string para adicionar à mensagem
    'checa o html e usar tags HTML em ligação

Next i

'Adiciona a string nome do arquivo para o corpo da mensagem e guardá-lo
'Verificar corpo HTML
If objMsg.BodyFormat <> olFormatHTML Then
    objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
Else
    objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
End If
    objMsg.Save
End If
Next

ExitSub:

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

Att