Adaptando um código que peguei na internet, resolvi a parada movendo todos os e-mails para uma pasta temporária, criada apenas para esta finalidade e resolvi o problema na boa.
Abaixo o código.
Option Explicit
Public Sub salvar_anexos()
On Error GoTo erro
Dim objApp As Outlook.Application
Dim pasta_outlook As Outlook.MAPIFolder
Dim objItem As Object
Dim arq_anexo As Outlook.Attachment
Dim pasta As String
'Pasta onde serão gravados os arquivos anexos dos emails:
pasta = "C:\Teste"
Set objApp = Outlook.Application
Set pasta_outlook = objApp.ActiveExplorer.CurrentFolder
If MsgBox("Deseja desanexar todos os arquivos da pasta " & pasta_outlook.Name, vbYesNo) = vbNo Then Exit Sub
For Each objItem In pasta_outlook.Items
DoEvents
'Se o objeto é do tipo email, começa a desanexar os arquivos
If objItem.Class = olMail Then
For Each arq_anexo In objItem.Attachments
DoEvents
arq_anexo.SaveAsFile pasta & "\" & arq_anexo.FileName
Next arq_anexo
End If
Next objItem
MsgBox "Processo finalizado!", vbOKOnly
Exit Sub
erro:
MsgBox Err.Number & " - " & Err.Description, vbOKOnly
Exit Sub
End Sub