Help with VBA code for use with Outlook mail!

[damonkey]

Hi All,

Would anyone be able to write a vba code that would allow me to extract the Subject and Entry ID of the mail inbox in Outlook?

I'm hoping someone would be able to help me out with this query.

 

[pbornemeier]

Open Outlook then run this code:

Option Explicit

 Sub ListAllItemsInInbox()
    'Adapted from http://www.mrexcel.com/forum/excel-questions/503118-macro-list-all-mails-present-my-outlook-inbox.html
    
    Dim oOutlook As Object
    'Dim OLF As Outlook.MAPIFolder
    Dim OLF As Object
    Dim CurrUser As String
    Dim EmailItemCount As Integer
    Dim i As Integer
    Dim EmailCount As Integer
    
    'Is Outlook Open?
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
        MsgBox "Outlook is not open, start Outlook and try again", , "Outlook Not Open"
        GoTo End_Sub
    End If
    
    'Application.ScreenUpdating = False
    Workbooks.Add ' create a new workbook
    ' add headings
    Range("A1").Resize(1, 5).Value = Array("Subject", "Recieved", "Attachments", "Read", "Entry ID")

    With Range("A1:E1").Font
        .Bold = True
        .Size = 14
    End With
    
    Application.Calculation = xlCalculationManual
    
    Set OLF = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6)  '6= olFolderInbox
    
    EmailItemCount = OLF.Items.Count
    i = 0: EmailCount = 0
    ' read e-mail information
    While i < EmailItemCount
        i = i + 1
        If i Mod 25 = 0 Then Application.StatusBar = "Reading e-mail messages " & _
        Format(i / EmailItemCount, "0%") & "..."
        With OLF.Items(i)
            EmailCount = EmailCount + 1
            On Error Resume Next    'Skip line item if certificate not valid
            Cells(EmailCount + 1, 1).Value = .Subject
            Cells(EmailCount + 1, 2).Value = Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
            Cells(EmailCount + 1, 3).Value = .Attachments.Count
            Cells(EmailCount + 1, 4).Value = Not .UnRead
            Cells(EmailCount + 1, 5).Value = .EntryID
            On Error GoTo 0
        End With
    Wend
    Columns("A:E").AutoFit
    Range("A2").Select
    
End_Sub:

    Set OLF = Nothing
    Application.Calculation = xlCalculationAutomatic
    ActiveWindow.FreezePanes = True
    ActiveWorkbook.Saved = True
    Application.StatusBar = False
    
End Sub

Good Excel-Outlook info at Mail from Excel with Outlook (VBA)