Ir para conteúdo
Fórum Script Brasil
  • 0

Manipular emails numa pasta do outlook pelo excel


vitorlsantos

Pergunta

 
Private Sub manipularEmailsemPastas()
 
'|---------------------------------------------------------------------------------------------------|
'|--Autor: Vitor Luiz dos Santos -- Data: 28/03/2019 ------------------------------------------------|
'|---------------------------------------------------------------------------------------------------|
'|--ATENÇÂOO - ESSE CÓDIGO SÓ FUNCIONA SE TU ATIVAR A REFERENCIA Microsft Outlook 16.0 Object Library|
'|---------------------------------------------------------------------------------------------------|
 
Dim outApp, mySpace, myFolder, emailItem As Object, row As Integer
'O abaixo é só se você quiser salvar uma pasta e colocar o email e os anexos dentro
Dim pathFile As String, Attachment As Outlook.Attachment
 
'Cria um objeto de outlook. Importante que o outlook esteja aberto. Caso não esteja ou queira testar use o CreateObject
Set outApp = GetObject(Class:="Outlook.Application") 'Caso saiba que o outlook estará aberto
'Set outApp = CreateObject(Class:="Outlook.Application") 'Caso não saiba se o outlook estará aberto
 
'Pega as pastas do seu email
Set mySpace = outApp.GetNamespace("MAPI") 'Não há outro tipo se não o MAPI que pega a sessão que está no outlook
 
'Pega a pasta especificada. Neste caso eu pego a pasta de enviados, mas poderia ser qualquer dafult
Set myFolder = mySpace.getDefaultFolder(olFolderSentMail) 'A lista de defaults está em https://docs.microsoft.com/pt-br/office/vba/api/outlook.oldefaultfolders
 
'Vai na pasta que está sendo executada, na primeira planilha e cria os cabeçalhos nas células a1 até a k1
ThisWorkbook.Worksheets(1).Range("A1:K1").Value = Array("Título", "Quem enviou", "Para", "Data e Hora", _
"Anexos", "Tamanho", "Última modificação", "Categoria", "Nome do Remetente", "Tipo de acompanhamento", "Conteúdo")
 
'Defino a primeira linha
row = 2
 
For Each emailItem In myFolder.Items
 
'|---------------------------------------------------------------------------------------------------|
'|--Este Código serve para caso queira pegar as informações dos emails-------------------------------|
'|---------------------------------------------------------------------------------------------------|
'Pego o email |
With emailItem ' |
Cells(row, 1) = .Subject 'Assunto do e-mail |
Cells(row, 2) = .SenderEmailAddress 'E-mail do remetente |
Cells(row, 3) = .To 'E-mail do destinatário |
Cells(row, 4) = .ReceivedTime 'Data/Hora de recebimento |
Cells(row, 5) = .Attachments.Count 'Número de anexos |
Cells(row, 6) = .Size 'Tamanho da mensagem em bytes |
Cells(row, 7) = .LastModificationTime 'Última modificação |
Cells(row, 8) = .Categories 'Categoria |
Cells(row, 9) = .SenderName 'Nome do remetente |
Cells(row, 10) = .FlagRequest 'Acompanhamento |
'Cells(r, 11) = olItem.Body 'corpo do email - CUIDADO |
End With ' |
row = row + 1 ' |
'|---------------------------------------------------------------------------------------------------|
 
'|---------------------------------------------------------------------------------------------------|
'|--Este Código serve para caso queira salvar os emails como msg em alguma pasta---------------------|
'|---------------------------------------------------------------------------------------------------|
emailItem.SaveAs Environ("temp") & "\file.msg" 'Environ pega a pasta default temp do usuário |
'|---------------------------------------------------------------------------------------------------|
 
'|---------------------------------------------------------------------------------------------------|
'|--Este Código serve para criar uma pasta para cada email e salvar o email e os anexos--------------|
'|---------------------------------------------------------------------------------------------------|
pathFile = Environ("temp") & Replace(Replace("\Email_" & Left(emailItem.Subject, 40) & "_Hora" & _
emailItem.ReceivedTime, ":", "_"), "/", "") ' |
' |
On Error Resume Next ' |
'Se não tiver esse diretório, cria |
If (Dir(pathFile, vbDirectory) = "") Then MkDir Path:=pathFile ' |
'Comente essa parte caso não queira a mensagem |
If (Dir(pathFile & "\mensagem", vbDirectory) = "") Then MkDir Path:=pathFile & "\mensagem" ' |
'Comente essa parte caso não queira os anexos |
If (Dir(pathFile & "\anexos", vbDirectory) = "") Then MkDir Path:=pathFile & "\anexos" ' |
' |
On Error GoTo 0 ' |
' |
emailItem.SaveAs pathFile & "\mensagem\mensagem.msg" 'Mensagem |
' |
For Each Attachment In emailItem.Attachments ' |
Attachment.SaveAsFile pathFile & "\anexos\" & Attachment.DisplayName 'Anexos |
Next Attachment ' |
'|---------------------------------------------------------------------------------------------------|
 
Next emailItem
 
'|---------------------------------------------------------------------------------------------------------|
'|--Fontes: |
'|Get Object: |
'|https://docs.microsoft.com/pt-br/office/vba/language/reference/user-interface-help/getobject-function |
'|Create Object: |
'|https://docs.microsoft.com/pt-br/office/vba/language/reference/user-interface-help/createobject-function |
'|GetNameSpace - Propriedade de Outlook.Application: |
'|https://docs.microsoft.com/pt-br/office/vba/api/outlook.application.getnamespace |
'|Environ: |
'|https://docs.microsoft.com/pt-br/office/vba/language/reference/user-interface-help/environ-function |
'|GetDefaultFolder: |
'|https://docs.microsoft.com/pt-br/office/vba/api/outlook.namespace.getdefaultfolder |
'|Arrays: |
'|https://docs.microsoft.com/pt-br/office/vba/language/reference/user-interface-help/array-function |
'| |
'|---------------------------------------------------------------------------------------------------------|
'|--Email para ajuda: vitorluizd.santos@gmail.com----------------------------------------------------------|
'|---------------------------------------------------------------------------------------------------------|
 
End Sub


 
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...