Export email sender, subject and other details using vba from outlook to excel sheet

[udayulisi]

I tried a code and it worked one day. From the next day it's giving my runtime error while retrieving sender name. Code belw:

Sub ImportEmail()
    ' Add a reference for "Microsoft Outlook nn.n Object Library"
 
    Dim objNS As Namespace
    Dim objFolder As Outlook.MAPIFolder
    Dim objSubFolder As Outlook.MAPIFolder
    Dim objEmail As Outlook.MailItem
    Dim intEmailIndex As Integer
    Dim intRowIndex As Integer
    Dim strMailBoxName As String
    Dim strFolderName  As String
    Dim datFromDate
    Dim datToDate As Date
    Dim objSheet As Worksheet
 
    ' Select folder to process
    Set objNS = Outlook.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objNS.PickFolder
    If TypeName(objFolder) = "Nothing" Then
        MsgBox "No fodler selected, cancelling."
        Exit Sub
    End If
 
    ' Specify from and to date range
'    datFromDate = #1/1/2015#
'    datToDate = #2/1/2016#
    datFromDate = DateValue(InputBox("Enter from date: "))
    datToDate = DateValue(InputBox("Enter to date: "))
 
    ' Export into first sheet in Excel
    Set objSheet = ThisWorkbook.Sheets(1)
    objSheet.Activate
    objFolder.Items.Sort "Received"
 
    ' Add Column Headers
    objSheet.Cells(1, 1) = "Sender Name"
    objSheet.Cells(1, 2) = "Sender Email"
    objSheet.Cells(1, 3) = "To"
    objSheet.Cells(1, 4) = "Subject"
    objSheet.Cells(1, 5) = "Received Time"
    objSheet.Cells(1, 6) = "Folder Name"
    objSheet.Cells(1, 7) = "Body"
 
    ' Process each email item in the selected folder
    intRowIndex = 1
    For intEmailIndex = 1 To objFolder.Items.Count
        Set objEmail = objFolder.Items.Item(intEmailIndex)
        ' Only process mail in the date range we want
        If objEmail.ReceivedTime >= datFromDate And objEmail.ReceivedTime <= datToDate Then
           intRowIndex = intRowIndex + 1
           objSheet.Cells(intRowIndex, 1).Select
           objSheet.Cells(intRowIndex, 1) = objEmail.SenderName
           objSheet.Cells(intRowIndex, 2) = objEmail.SenderEmailAddress
           objSheet.Cells(intRowIndex, 3) = objEmail.To
           objSheet.Cells(intRowIndex, 4) = objEmail.Subject
           objSheet.Cells(intRowIndex, 5) = objEmail.ReceivedTime
           objSheet.Cells(intRowIndex, 6) = objFolder.Name
           objSheet.Cells(intRowIndex, 7) = objEmail.Body
        End If
    Next intEmailIndex
 
    MsgBox (intRowIndex - 1) & " emails selected and exported."
 
End Sub

[Luuk]

Info on the exact error is missing...

Like this (sorry for the fact that i have a Dutch version):

Most import thing is what line is shown when you click 'Foutopsporing' (the currently selected button)

When you did this yourself, you would have found that this line is causing the problem:

[udayulisi]

I am getting an error at objEmail.SenderName and the error is Run-time error '287':
Application-defined or object-defined error. The same is related for Sender email address, objEmail.To and objEmail.Body as well.
Hope the details will help to understand the issue. Please help

[Luuk]

I am not able to reproduce this error.

Can you try to add this line of code on line#3

    Application.EnableEvents = True
 

and see if that changes things...

[udayulisi]

I tried with enable events but still getting the same error. One point I would like to inform. It worked for a day and there after not working. I am using this code on an office outlook. Is that something we need to manage the security permissions to get sender name? Except sender name, sender email and body fiepds, remaining fields like subject, received time etc are getting exported to excel.

[Luuk]

I am sorry to say that I could not find a good reference which explains 'Run-time error '287'' .

The 'best' solution seems to be:
source: https://social.msdn.microsoft.com/Fo...orum=accessdev

Function YourFunction()
  On Error Goto Error_Proc
 
  ' all your usual code goes here'
 
 
Exit_Proc:
  'this is your exit portion'
  'all exits will be directed here'
  'use this to clean up any open objects'
  Exit Function
Error_Proc:
  'this is your error handler'
  'with the On Error statement at the top,'
  'any errors jump to the specified label'
  ''
  'check errors:'
  Select Case Err.Number
    Case 287:
      Resume Exit_Proc 'ignore the error'
    Case Else:
      MsgBox "Error encountered: " & Err.Description
      Resume Exit_Proc 'display a message then exit'
End Function

I cannot test that because I do not (yet) see that error.
The code should just ignore the error, and tries to continue.

[udayulisi]

The code worked for one day and from the n3xt day it's not working. Looks some security permissions have been disabled unknowingly while testing the code. Can anyone help me to check where the security settings exists in outlook and can those be handled through macro while running the code and revert back to the existing settings.