Export Email from outlook to excel and calculated time between received email and task completed

[shafiq2]

Hi,

I am not sure if the following is possible, but just to give a try,

I am looking for VBA code to export outlook email to excel and calculate time between an email received and when task completed.

we have to log each email (Task) received and the last response date when task completed.

So we log as follow.

From, Requesting Unit, Subject, Request Type, Assigned To, Date Received , Date completed, Comments , Item Type,

Best Regards,

 

[Sathish KV]

Hi,

The below code will download all messages from inbox to excel

Sub ListAllItemsInInbox()
 
Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
    Application.ScreenUpdating = False
    Workbooks.Add ' create a new workbook
    ' add headings
    Cells(1, 1).Formula = "Subject"
    Cells(1, 2).Formula = "Recieved"
    Cells(1, 3).Formula = "Attachments"
    Cells(1, 4).Formula = "Read"
    Cells(1, 5).Formula = "Body of the Message"
    Cells(1, 6).Formula = "From"
    Cells(1, 7).Formula = "To"
    Cells(1, 8).Formula = "Cc"
   
    With Range("A1:H1").Font
        .Bold = True
        .Size = 14
    End With
    Application.Calculation = xlCalculationManual
    Set OLF = GetObject("", _
        "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    EmailItemCount = OLF.Items.Count
    i = 0: EmailCount = 0
    ' read e-mail information
    While i < EmailItemCount
        i = i + 1
        If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & _
            Format(i / EmailItemCount, "0%") & "..."
        With OLF.Items(i)
            EmailCount = EmailCount + 1
            Cells(EmailCount + 1, 1).Formula = .Subject
            Cells(EmailCount + 1, 2).Formula = Format(.ReceivedTime, "mm/dd/yyyy hh:mm")
            Cells(EmailCount + 1, 3).Formula = .Attachments.Count
            Cells(EmailCount + 1, 4).Formula = Not .UnRead
            Cells(EmailCount + 1, 5).Formula = .Body
            Cells(EmailCount + 1, 6).Formula = .SenderEmailAddress
          On Error Resume Next
            Cells(EmailCount + 1, 7).Formula = .To
            Cells(EmailCount + 1, 8).Formula = .CC
           
        End With
    Wend
    Application.Calculation = xlCalculationAutomatic
    Set OLF = Nothing
    Cells.WrapText = False
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    ActiveWorkbook.Saved = True
    Application.StatusBar = False
   
End Sub

 

[shafiq2]

Thanks Sathish for the code, I have similar code which export data from outlook to excel but this is not exactly what I was looking for.

Best Regards,