Excel 2013 Perspectives bénéficiaire Resolve ne

Question

je le code suivant qui a bien fonctionné dans Excel 2007, mais échoue dans 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 

Ce que je fais est l'analyse des e-mails à partir d'un dossier dans ma boîte de réception. Cependant, j'ai besoin de résoudre le destinataire, mais cela échoue. Le code que vous voyez commence le sous-marin et le reste du code suit la méthode de résolution.

L'erreur renvoyée est:

Erreur d'exécution « 287 »: application défini ou un objet défini erreur

L'aide d'erreur ne fournit pas vraiment des informations utiles. D'autant plus que cela a fonctionné parfaitement dans Excel 2007 mais maintenant échoue après une "mise à niveau" vers Excel 2013.

J'ai essayé "smithj1@company.org" et "John Smith" et "John A. Smith", etc. (ce n'est pas le vrai nom) mais rien ne fonctionne. Lorsque j'ai copié cela sur un ordinateur portable qui contenait encore Office 2007, le code fonctionnait parfaitement. Au bout d'une heure, l'ordinateur portable a été automatiquement mis à niveau vers Office 2013 et le code a échoué.

Toute aide serait grandement appréciée.

Answer 1

Essayez d'attendre pour voir s'il y a une réponse différée.

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