VBA Outlook - Pesquise todos os e-mails no Outlook e extraia informações - Browse through all emails in Sub Folders of Specific Folder in Outlook and extract the information

Termo de Responsabilidade

Efetuar um loop em todos os e-mails disponíveis na sua estrutura do MS Outlook deve ser muito útil em algumas circunstâncias de identificação.

Dim oitem As Outlook.MailItem

Sub browse_all_emails_in_all_subfolders_of_specific_folder()

'Tools Reference Microsoft Outlook 

Dim olapp As Outlook.Application

Dim olappns As Outlook.Namespace

Dim oinbox As Outlook.Folder

Dim oFolder As Outlook.MAPIFolder

'tools->refrence->microsoft outlook

Set olapp = New Outlook.Application

Set olappns = olapp.GetNamespace("MAPI")

Set oinbox = olappns.GetDefaultFolder(olFolderInbox)

Set oinbox = oinbox.Folders("Ashish")

For Each oitem In oinbox.Items

' u can add if condtions to filter the emails etc.

' u can add data it to excel sheet or database table

MsgBox "Mail Subject -> " & oitem.Subject

MsgBox "Sender Email Address -> " & oitem.SenderEmailAddress

MsgBox "Sender Name -> " & oitem.SenderName

MsgBox "Mail Body -> " & oitem.Body

MsgBox "Recived Date -> " & oitem.ReceivedTime

MsgBox oinbox.Name

MsgBox oinbox.FolderPath

Next

For Each oFolder In oinbox.Folders

Call subfolders_go(oFolder)

Next

End Sub

Private Sub subfolders_go(oParent As Outlook.Folder)

Dim oFolder1 As Outlook.MAPIFolder

For Each oitem In oParent.Items

' u can add if condtions to filter the emails etc.

' u can add data it to excel sheet or database table

MsgBox "Mail Subject -> " & oitem.Subject

MsgBox "Sender Email Address -> " & oitem.SenderEmailAddress

MsgBox "Sender Name -> " & oitem.SenderName

MsgBox "Mail Body -> " & oitem.Body

MsgBox "Recived Date -> " & oitem.ReceivedTime

MsgBox oParent.Name

MsgBox oParent.FolderPath

Next

If (oParent.Folders.Count > 0) Then

For Each oFolder1 In oParent.Folders

Call subfolders_go(oFolder1)

Next

End If

End Sub

Reference: Excelvbamacros.com

Tags: VBA, Outlook, folder, loop, extract