Bom dia!!

Veja se te ajuda.
Não testado!

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
        saveFolder = "C:Temp"
    Dim dateFormat As String
        'dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "" & dateFormat & objAtt.DisplayName
    Next
End Sub
      Sub WykazKodowKontrola(Item As MailItem)
         If Item.Class = olMail Then
         If Item.Attachments.Count > 0 Then
         Dim objAtt As Outlook.Attachments
         Set objAtt = Item.Attachments
         For Each objAttach In objAtt
         objAttach.SaveAsFile "C:Temp" & _
         Item.Subject & "_" & objAttach.Filename
         Next
         Set objAtt = Nothing
         End If
         End If
        End Sub

Leia:
http://www.extendoffice.com/documents/o ... ments.html

Att

Boa tarde!
Para o código de salvar anexos, tenho uma dúvida.
Se eu receber por exemplo dois e-mails diferentes e os dois venham com anexos de nomes iguais.
Como fazer? Ele sobrescreve o primeiro, permancendo o segundo, ou dá para manter os dois, porém adicionando algum prefixo ao segundo ao salvar?

Alguém poderia me ajudar ?

Esse seria o código:

Public Sub ProcessarAnexo(Email As MailItem)
    Dim DiretorioAnexos As String
    Dim Anexo As Attachment

                      'Insira aqui o caminho da pasta onde serão salvos os arquivos
    DiretorioAnexos = "C:teste"

    '|Explicação do código - passo a passo
    
    '|Para cada e-mail que chegar e que tiver anexos, o código vai analisar o tipo/formato do anexo
    For Each Anexo In Email.Attachments
    
    '|Se for anexo do tipo .XML o código irá salvar este arquivo no caminho acima especificado
    If LCase(Right(Anexo.Filename, 3)) = "xml" Then
    
    '|O arquivo será salvo no caminho especificado com o mesmo nome enviado,
    '|não haverá alteração no nome do arquivo
    Anexo.SaveAsFile DiretorioAnexos & Anexo.Filename
    
    End If
    Next

End Sub