Excel 2013 Outlook Recipient Resolve fails - vba

Question

I have the following code that worked fine in Excel 2007 but fails in Excel 2013.
Dim lappOutlook As Outlook.Application
Dim lappNamespace As Outlook.Namespace
Dim lappRecipient As Outlook.RECIPIENT
Set lappOutlook = CreateObject("Outlook.Application")
Set lappNamespace = lappOutlook.GetNamespace("MAPI")
Set lappRecipient = lappNamespace.CreateRecipient("smithj1")
lappRecipient.Resolve
What I'm doing is parsing emails from a folder in my inbox. However, I need to resolve the recipient but that fails. The code you see starts out the sub and the remainder of the code follows the resolve method.
The error returned is:
Run-time error '287':
Application-defined or object-defined error
The error help really does not provide any useful information. Especially since this worked perfectly in Excel 2007 but now fails after an "upgrade" to Excel 2013.
I have tried "smithj1#company.org" and "John Smith" and "John A. Smith", etc. (those are not the real name) but nothing works. When I copied this to a laptop that still had Office 2007 on it, the code ran perfectly. Within the hour, the laptop was "upgraded" automatically to Office 2013 and the code failed.
Any help would be greatly appreciated.

Answer 1

Try waiting to see if there is a delayed response.
Private Sub openOutlook2()
Dim lappOutlook As Outlook.Application
Dim lappNamespace As Outlook.Namespace
Dim lappRecipient As Outlook.Recipient
Dim strAcc As String
Dim maxTries As Long
Dim errCount As Long
Set lappOutlook = CreateObject("Outlook.Application")
Set lappNamespace = lappOutlook.GetNamespace("MAPI")
strAcc = "smithj1"
Set lappRecipient = lappNamespace.CreateRecipient(strAcc)
maxTries = 2000
On Error GoTo errorResume
Retry:
DoEvents
' For testing error logic. No error with my Excel 2013 Outlook 2013 setup.
' Should normally be commented out
'Err.Raise 287
lappRecipient.Resolve
On Error GoTo 0
If lappRecipient.Resolved Then
Debug.Print strAcc & " resolved."
MsgBox strAcc & " resolved."
Else
Debug.Print strAcc & " not resolved."
MsgBox "No error: " & strAcc & " not resolved."
End If
ExitRoutine:
Set lappOutlook = Nothing
Set lappNamespace = Nothing
Set lappRecipient = Nothing
Debug.Print "Done."
Exit Sub
errorResume:
errCount = errCount + 1
' Try until Outlook responds
If errCount > maxTries Then
' Check if Outlook is there and Resolve is the issue
lappNamespace.GetDefaultFolder(olFolderInbox).Display
GoTo ExitRoutine
End If
Debug.Print errCount & " - " & Err.Number & ": " & Err.Description
Resume Retry
End Sub