Fiinguer,
Boa noite!
Peço, por gentileza, não utilizar citações de inteiro teor das mensagens que lhe são enviadas em suas respostas. Citações, quando estritamente necessárias ao entendimento das mensagens que você quer enviar, pelo seu interlocutor, devem restringir-se a pequenos trechos apenas.
No próprio link que lhe passei, nos comentários, o autor do código responde a um usuário sobre essa mesma dúvida sua. Basta declarar a variável que não está declarada.
Veja abaixo, código completo sem erro e após teste que fiz.
Sub Emails_Outlook()
'=========================================================================
'Código Desenvolvido por Douglas Godoy em 2013 para resposta de usuário _
no fórum Clube do Hardware
'Trás todos os dados de mensagens do Outlook para o Excel
'=========================================================================
'Carregar e-mails do outlook para o excel
Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long
Dim olMail As Object
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
Set olMail = appOutlook.CreateItem(0)
On Error GoTo 0
Set olNS = appOutlook.GetNamespace("MAPI")
'Abaixo preencha o nome do arquivo de dados PST e a pasta.
'Neste caso o arquivo é Douglas Godoy e a pasta Caixa de Entrada.
Set olFolder = olNS.Folders("Pastas Particulares").Folders("Caixa de Entrada")
Cells.Delete
r = 3
'Cria um array montando o título das colunas no arquivo.
Range("A3:K3") = Array("Título", "Quem enviou", "Para", "Data e Hora", "Anexos", "Tamanho", "Última modificação", "Categoria", "Nome do Remetente", "Tipo de acompanhamento", "Conteúdo")
For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
r = r + 1
Cells(r, "A") = olItem.Subject 'Assunto do e-mail
Cells(r, "B") = olItem.SenderEmailAddress 'E-mail do remetente
Cells(r, "C") = olItem.To 'E-mail do destinatário
Cells(r, "D") = olItem.ReceivedTime 'Data/Hora de recebimento
Cells(r, "E") = olItem.Attachments.Count 'Número de anexos
Cells(r, "F") = olItem.Size 'Tamanho da mensagem em bytes
Cells(r, "G") = olMail.LastModificationTime 'Última modificação
Cells(r, "H") = olMail.Categories 'Categoria
Cells(r, "I") = olMail.SenderName 'Nome do remetente
Cells(r, "J") = olMail.FlagRequest 'Acompanhamento
'Cells(r, "K") = olItem.Body 'Tome cuidado ao utilizar pois carrega os dados do corpo do email
Application.StatusBar = r
End If
Next olItem
Columns.AutoFit
End Sub
Postado : 08/06/2018 4:02 pm