424,066 Members | 2,123 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,066 IT Pros & Developers. It's quick & easy.

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

P: 4
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:

Expand|Select|Wrap|Line Numbers
  1. Sub ImportEmail()
  2.     ' Add a reference for "Microsoft Outlook nn.n Object Library"
  3.  
  4.     Dim objNS As Namespace
  5.     Dim objFolder As Outlook.MAPIFolder
  6.     Dim objSubFolder As Outlook.MAPIFolder
  7.     Dim objEmail As Outlook.MailItem
  8.     Dim intEmailIndex As Integer
  9.     Dim intRowIndex As Integer
  10.     Dim strMailBoxName As String
  11.     Dim strFolderName  As String
  12.     Dim datFromDate
  13.     Dim datToDate As Date
  14.     Dim objSheet As Worksheet
  15.  
  16.     ' Select folder to process
  17.     Set objNS = Outlook.GetNamespace("MAPI")
  18.     Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
  19.     Set objFolder = objNS.PickFolder
  20.     If TypeName(objFolder) = "Nothing" Then
  21.         MsgBox "No fodler selected, cancelling."
  22.         Exit Sub
  23.     End If
  24.  
  25.     ' Specify from and to date range
  26. '    datFromDate = #1/1/2015#
  27. '    datToDate = #2/1/2016#
  28.     datFromDate = DateValue(InputBox("Enter from date: "))
  29.     datToDate = DateValue(InputBox("Enter to date: "))
  30.  
  31.     ' Export into first sheet in Excel
  32.     Set objSheet = ThisWorkbook.Sheets(1)
  33.     objSheet.Activate
  34.     objFolder.Items.Sort "Received"
  35.  
  36.     ' Add Column Headers
  37.     objSheet.Cells(1, 1) = "Sender Name"
  38.     objSheet.Cells(1, 2) = "Sender Email"
  39.     objSheet.Cells(1, 3) = "To"
  40.     objSheet.Cells(1, 4) = "Subject"
  41.     objSheet.Cells(1, 5) = "Received Time"
  42.     objSheet.Cells(1, 6) = "Folder Name"
  43.     objSheet.Cells(1, 7) = "Body"
  44.  
  45.     ' Process each email item in the selected folder
  46.     intRowIndex = 1
  47.     For intEmailIndex = 1 To objFolder.Items.Count
  48.         Set objEmail = objFolder.Items.Item(intEmailIndex)
  49.         ' Only process mail in the date range we want
  50.         If objEmail.ReceivedTime >= datFromDate And objEmail.ReceivedTime <= datToDate Then
  51.            intRowIndex = intRowIndex + 1
  52.            objSheet.Cells(intRowIndex, 1).Select
  53.            objSheet.Cells(intRowIndex, 1) = objEmail.SenderName
  54.            objSheet.Cells(intRowIndex, 2) = objEmail.SenderEmailAddress
  55.            objSheet.Cells(intRowIndex, 3) = objEmail.To
  56.            objSheet.Cells(intRowIndex, 4) = objEmail.Subject
  57.            objSheet.Cells(intRowIndex, 5) = objEmail.ReceivedTime
  58.            objSheet.Cells(intRowIndex, 6) = objFolder.Name
  59.            objSheet.Cells(intRowIndex, 7) = objEmail.Body
  60.         End If
  61.     Next intEmailIndex
  62.  
  63.     MsgBox (intRowIndex - 1) & " emails selected and exported."
  64.  
  65. End Sub
3 Weeks Ago #1
Share this Question
Share on Google+
6 Replies


Expert 100+
P: 964
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:

Attached Images
File Type: png error.png (4.9 KB, 103 views)
File Type: png received.png (3.5 KB, 103 views)
2 Weeks Ago #2

P: 4
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
2 Weeks Ago #3

Expert 100+
P: 964
I am not able to reproduce this error.

Can you try to add this line of code on line#3
Expand|Select|Wrap|Line Numbers
  1.     Application.EnableEvents = True
  2.  
and see if that changes things...
2 Weeks Ago #4

P: 4
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.
2 Weeks Ago #5

Expert 100+
P: 964
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
Expand|Select|Wrap|Line Numbers
  1. Function YourFunction()
  2.   On Error Goto Error_Proc
  3.  
  4.   ' all your usual code goes here'
  5.  
  6.  
  7. Exit_Proc:
  8.   'this is your exit portion'
  9.   'all exits will be directed here'
  10.   'use this to clean up any open objects'
  11.   Exit Function
  12. Error_Proc:
  13.   'this is your error handler'
  14.   'with the On Error statement at the top,'
  15.   'any errors jump to the specified label'
  16.   ''
  17.   'check errors:'
  18.   Select Case Err.Number
  19.     Case 287:
  20.       Resume Exit_Proc 'ignore the error'
  21.     Case Else:
  22.       MsgBox "Error encountered: " & Err.Description
  23.       Resume Exit_Proc 'display a message then exit'
  24. 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.
2 Weeks Ago #6

P: 4
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.
2 Weeks Ago #7

Post your reply

Sign in to post your reply or Sign up for a free account.