Consulting

Results 1 to 6 of 6

Thread: Keep getting error Message: Run-time error '287': Application-defined or object-defi

  1. #1

    Keep getting error Message: Run-time error '287': Application-defined or object-defi

    Hey guys

    I use a spread sheet with a macro built by someone who left my team a year or so ago - Up until now I've had no issues with the Macro.
    The macro pulls data from a mailbox in Outlook when you click a button within the spread sheet. We have recently moved to Windows 10 and I've been advised that this was when the macro has stopped working. Could the move to Windows 10 be causing an issue with the Macro or could it be something else? I'm not 100% certain if someone else in my team has tried to fix this macro before coming to me.
    Please see below the section of the marco that is getting highlighted when I click the 'Debug' button in the error msg:

    Sub ExportToExcel()


    'On Error GoTo ErrHandle
    Dim appExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    Dim workbookFile As String
    Dim msg As Outlook.MailItem
    Dim nms As Outlook.Namespace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    Dim irow As Integer
    Dim olApp As Object
    Dim iSender As String
    Dim iLast As Integer


    iLast = Sheets("ACTIVE").Range("C" & Rows.Count).End(xlUp).Row
    Set olApp = CreateObject("Outlook.Application")
    'Select export folder
    Set nms = olApp.Application.GetNamespace("MAPI")
    Set fld = nms.Folders("Selections").Folders("Inbox")


    'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.DefaultItemType <> olMailItem Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.Items.Count = 0 Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    End If


    'Open and activate Excel workbook.


    Set wks = Sheets("ACTIVE")
    wks.Activate
    Application.Visible = True


    'Copy field items in mail folder.


    For Each itm In fld.Items


    irow = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
    If itm.Class = Outlook.OlObjectClass.olMail Then
    Set msg = itm
    If msg.SentOn > wks.Range("A" & iLast).Value Then
    wks.Range("D" & irow) = msg.Subject
    wks.Range("A" & irow) = msg.SentOn
    wks.Range("B" & irow) = msg.SentOn
    wks.Range("F" & irow) = msg.SenderName
    wks.Range("H" & irow) = ResolveDisplayNameToSMTP(msg.SenderName)


    iSender = wks.Range("F" & irow).Value
    iTable = Sheets("ContactLIst").Range("Contacts")
    If wks.Range("H" & irow) = "" Then
    iformula = Application.VLookup(iSender, iTable, 3, False)
    If IsError(iformula) Then
    wks.Range("H" & irow) = ""
    Else
    wks.Range("H" & irow) = iformula
    End If
    End If
    If wks.Range("H" & irow) = "" Then
    wks.Range("H" & irow) = msg.SenderEmailAddress
    End If
    End If
    End If

    Next

    Call AddDep


    irow = Sheets("ACTIVE").Range("A" & Rows.Count).End(xlUp).Row


    Sheets("ACTIVE").Range("A" & iLast & ":H" & irow).Sort key1:=Sheets("ACTIVE").Range("A" & iLast), order1:=xlAscending, Header:=xlNo


    Sheets("ACTIVE").Range("A" & iLast & ":H" & irow).NumberFormat = "dd/mm/yyyy"
    Sheets("ACTIVE").Range("B" & iLast & ":H" & irow).NumberFormat = "h:mm"

    Set appExcel = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    Set olApp = Nothing

    irow = 0
    End Sub



    Function ResolveDisplayNameToSMTP(sFromName)
    Dim oRecip As Outlook.Recipient
    Dim oEU As Outlook.ExchangeUser
    Dim oEDL As Outlook.ExchangeDistributionList
    Dim olApp As Object
    Set olApp = CreateObject("Outlook.Application")

    Set oRecip = olApp.Application.Session.CreateRecipient(sFromName)

    oRecip.Resolve
    If oRecip.Resolved Then
    Select Case oRecip.AddressEntry.AddressEntryUserType
    Case OlAddressEntryUserType.olExchangeUserAddressEntry
    Set oEU = oRecip.AddressEntry.GetExchangeUser
    If Not (oEU Is Nothing) Then
    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress '+ vbCrLf + oEU.BusinessTelephoneNumber
    End If
    Case OlAddressEntryUserType.olOutlookContactAddressEntry
    Set oEU = oRecip.AddressEntry.GetExchangeUser
    If Not (oEU Is Nothing) Then
    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress '+ vbCrLf + oEU.BusinessTelephoneNumber
    End If
    Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
    Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList
    If Not (oEDL Is Nothing) Then
    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress '+ vbCrLf + oEU.BusinessTelephoneNumber
    End If
    End Select
    End If
    End Function ' ResolveDisplayNameToSMTP



    Sub AddDep()


    Dim irow As Integer
    Dim iLast As Integer
    Dim wks As Excel.Worksheet


    Set wks = Sheets("ACTIVE")


    iLast = Sheets("ACTIVE").Range("C" & Rows.Count).End(xlUp).Row
    irow = wks.Range("A" & Rows.Count).End(xlUp).Row
    For i = iLast To irow
    iSender = wks.Range("F" & i).Value
    iTable = Sheets("ContactLIst").Range("Contacts")
    If wks.Range("G" & i) = "" Then
    iformula = Application.VLookup(iSender, iTable, 2, False)
    If IsError(iformula) Then
    Else
    wks.Range("G" & i) = iformula
    End If
    End If
    Next i
    End Sub

    Any help trying to fix this marco/figure out why I'm getting the error msg would be much appreciated!!
    Could it be the move to Windows 10?

    Thank you!!
    Rosie

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Welcome to the forum! Please paste code between code tags so we can see structure. Click # icon on reply toolbar to insert the tags.

    1. Put Option Explicit as the first line of code as the first line of code in a Module or Userform.
    2. In Visual Basic Editor (VBE) Compile code before a Run. It is in the Debug menu.
    3. Fix missing variables where Type was not set in Dim.
    4. All variables that will return a row number, make sure that it is type Long. Integers are not big enough for some big row numbers.
    5. Why to columns for SendOn?
    6. Since the next line after the error calls a function, try commenting the error line out to see if it runs. Even if the SendName was empty it should not have erred. I have not used SendName so I will look at that. Exchange can do some odd things.
    a. If this works, try using On Error Resume Next earlier in the code.

    I will look at this a bit more. Some parts I may not be able to test. As is, even if it did run without error, it could be very slow.

  3. #3
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    I think that's an Outlook security issue. Your code will need to be trusted to run.
    Be as you wish to seem

  4. #4
    How do I trust the code for it to run?
    I've been advised by my IT dept that it's an issue with moving to Outlook 2016.
    I'm not quite sure how to re-trust the code or alter the code slightly to work with the newer version of Outlook?

  5. #5
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Did you check Tools > References, to make sure that the newer version of Outlook is selected?

    In Outlook, File > Options > Trust Center is where you set security. Likely, IT has locked you from changing it.

    You could try adding a certificate to the code.

  6. #6
    VBAX Newbie
    Joined
    Dec 2017
    Location
    Cleveland
    Posts
    5
    Location
    Hello,


    I am facing a similar issue with the '287' issue. In my case, it's happening on the oRecip.Resolve line. The first thing I noticed is that it's changing this line to oRecip.resolve (lowercase resolve).


    When I step through the code, it stops on this line with the '287' error code.


    We are using Office 2016.


    Two "Trust Center" images are attached: one from Excel and one from Outlook.


    Any suggestions are greatly appreciated.


    Thanks!


    Dennis287 excel.JPG287 outlook.JPG

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •