domingo, 25 de dezembro de 2011

Outlook VBA - Desanexando todos arquivos

Outro dia me deparei com uma situação diferente: ter de desanexar aproximadamente 150 arquivos/e-mails.
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

Um comentário:

Anônimo disse...

Boa tarde
parabens muito boa dica
será que teria como identificar o remetente e nomear o arquivo com o nome do remetente?


Pesquisar este blog

Arquivo do blog

Quem sou eu

Minha foto
Administrador de Empresas/Técnico em Processamento de Dados. Microsoft Office User Specialist - Excel Proficient. Pós-graduado em Business Intelligence.