Macro para salvar um anexo de um email do Outlook





Vamos usar o código abaixo, que você deve colocar em um módulo em uma planilha do Excel. Você também precisa definir uma referência para o Microsoft (Office) Biblioteca Outlook em Ferramentas – Referências no editor VB antes de executar ou compilar o código.

Assume-se os e-mails estão na pasta Caixa de entrada (mudar esta parte do código onde indicado se não, ou use o método PickFolder atualmente comentada para que o usuário selecione a pasta Outlook). Os e-mails devem ter o assunto exato “TITULO DO EMAIL”.

Public Sub Extract_Outlook_Email_Attachments()

Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String
Dim saveInFolder As String

saveInFolder = "C:\path\to\folder\" 'TROCAR PASTA
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"

subjectFilter = "TITULO DO EMAIL" 'TROCAR TITULO DO EMAIL

'Get or create Outlook object and make sure it exists before continuing

OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo 0

If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If

Set outNs = outApp.GetNamespace("MAPI")

Set outFolder = outNs.Folders("Personal Folders").Folders("Inbox") 'CHANGE FOLDER AS NEEDED
'Set outFolder = outNs.PickFolder 'OR USER SELECTS FOLDER

If Not outFolder Is Nothing Then
For Each outItem In outFolder.Items
If outItem.Class = Outlook.OlObjectClass.olMail Then
Set outMailItem = outItem
If outMailItem.Subject = subjectFilter Then
Debug.Print outMailItem.Subject
For Each outAttachment In outMailItem.Attachments
outAttachment.SaveAsFile saveInFolder & outAttachment.Filename
Next
End If
End If
Next
End If

If OutlookOpened Then outApp.Quit

Set outApp = Nothing

End Sub

Macro para enviar email





macro para enviar email

Assim como obter dados da Internet, o Excel também permite enviar e-mails com o seu relatório através de uma conta do Microsoft Outlook.

Uma maneira simples de fazer a tarefa é usar a seguinte macro para enviar o arquivo inteiro:

Sub Email()

ActiveWorkbook.SendMail “email_do_destinatário@email.com”, “Título do Email”

End Sub

 

Se você quiser enviar apenas uma de suas abas dentro de um novo arquivo, uma maneira interessante de fazer é criar um novo arquivo, copiar a aba para este arquivo e fazer o envio do email

 

‘Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc

nomedaaba = “Plan1”

 

‘Criar um novo arquivo excel

Set NovoArquivo = Application.Workbooks.Add

 

‘Copiar a planilha para o novo arquivo criado

ThisWorkbook.Sheets(nomedaaba).Copy Before:=NovoArquivo.Sheets(1)

 

‘Salvar o arquivo

ThisWorkbook.SaveAs ThisWorkbook.Path & “\NovoArquivo” & “.xlsm”

nomecompleto = NovoArquivo.FullName

 

‘Enviar o email

ThisWorkbook.SendMail “email_do_destinatario@email.com”, “Título do Email”

 

‘Fechar o arquivo novo

ThisWorkbook.Close

Faça o curso completo de Macros para Excel conosco: