Récupérer des mail dans Outlook: erreur 287

Version imprimable

Bonjour tous le monde.
Voila mon problème: je veux récupérer les informations dans des mails de mon compte Outlook.
J'utilise la fonction suivante qui marche très bien sur mon mail perso (mail SMTP), mais ne fonctionne pas pour mon mail pro (mail EX).
Je voudrai récupérer les mêmes informations qu'en SMTP.
Pour information mon Outlook est toujours ouvert derrière, je n'ai pas de code à rentrer appart celui de la session windows, les 3 premières demandes d'information fonctionnent dans les deux cas.
Je peux ouvrir une fenêtre avec le mail consulté dedans, le déplacer dans un autre dossier également dans les deux cas.
Merci pour votre aide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Function ImporterMailWO()
    Dim appOl As New Outlook.Application
    Dim ns As Namespace
    Dim inboxWOimporte As MAPIFolder
    Dim inboxWOtraite As MAPIFolder
    Dim mail As MailItem
    
    Set appOl = CreateObject("Outlook.Application")
    Set ns = appOl.GetNamespace("MAPI")
    Set inboxWOimporte = ns.GetDefaultFolder(olFolderInbox).Folders("WO importé")
    Set inboxWOtraite = ns.GetDefaultFolder(olFolderInbox).Folders("WO traité")
     
    For Each mail In inboxWOimporte.Items
        
        'si Outlook passe par un exchange
        If mail.SenderEmailType = "EX" Then
            
        MsgBox (mail)
        MsgBox (mail.ReceivedTime)
        MsgBox (mail.Subject)
        MsgBox (mail.Sender.GetExchangeUser.PrimarySmtpAddress)    ->  Erreur d'exécution 287 - Erreur définie par l'application ou par l'objet
        MsgBox (mail.SenderEmailAddress)                                         ->  Erreur d'exécution 287 - Erreur définie par l'application ou par l'objet
        MsgBox (mail.CC)                                                                  ->  Erreur d'exécution 287 - Erreur définie par l'application ou par l'objet
        MsgBox (mail.Body)                                                               ->  Erreur d'exécution 287 - Erreur définie par l'application ou par l'objet
        
        
        'si Outlook est de type SMTP
        Else
        MsgBox (mail)
        MsgBox (mail.ReceivedTime)
        MsgBox (mail.Subject)
        MsgBox (mail.SenderEmailAddress)
        MsgBox (mail.CC)
        MsgBox (mail.Body)
        MsgBox (mail.SenderEmailType)
        
        End If
        
        'déplacer le mail dans le fichier inboxWOtraite
        mail.Move inboxWOtraite
           
    Next mail

End Function

Bonjour,

Je n'ai pas la réponse, mais je vois une incongruité ici
Code:

1 2 3 4 5 6 7 Dim appOl As New Outlook.Application Dim ns As Namespace Dim inboxWOimporte As MAPIFolder Dim inboxWOtraite As MAPIFolder Dim mail As MailItem Set appOl = CreateObject("Outlook.Application")
Nul besoin d'utiliser CreateObject si tu as mis une référence et ajouté New Outlook.Application
Soit tu supprimes la ligne du CreateObject et tu utilises la référence, soit tu supprimes la référence, tu mets toutes tes variables Outlook As Object et tu conserves le CreateObject

Bonjour,

essaye cette fonction

Code:

1
2
3
4
5
6
7
8
Private Function Get_sender_SMTP(Oitem As Outlook.MailItem) As String
    Dim oEU As Outlook.ExchangeUser
    On Error Resume Next
    Set oEU = Oitem.Sender.GetExchangeUser
 
    Get_sender_SMTP = oEU.PrimarySmtpAddress
    If Get_sender_SMTP = "" Then Get_sender_SMTP = Oitem.SenderEmailAddress
End Function

05/03/2018, 07h16
cosmic74

Merci Parmi pour ta remarque, j'ai essayer la correction des deux façon rien pas de différence.
Oliv-: j'ai essayer ton code, il ne me retourne pas d'erreur, comme elles sont gérées.
Par-contre je n'ai pas d'information non plus, il me retourne un champs vide pour Oitem.Sender.GetExchangeUser et également pour oEU.PrimarySmtpAddress.

Si vous avez d'autres pistes???
merci d'avance

Bonjour,
Je ênse que tu as mal utilisé la fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Function ImporterMailWO()
    Dim appOl As New Outlook.Application
    Dim ns As Namespace
    Dim inboxWOimporte As MAPIFolder
    Dim inboxWOtraite As MAPIFolder
    Dim mail As MailItem
 
    Set appOl = CreateObject("Outlook.Application")
    Set ns = appOl.GetNamespace("MAPI")
    Set inboxWOimporte = ns.GetDefaultFolder(olFolderInbox).Folders("WO importé")
    Set inboxWOtraite = ns.GetDefaultFolder(olFolderInbox).Folders("WO traité")
 
    For Each mail In inboxWOimporte.Items
 
        MsgBox Get_sender_SMTP(mail)
 
        MsgBox (mail.Subject & vbCr & mail.ReceivedTime & vbCr & mail.CC & vbCr & "#######################################" & vbCr & mail.Body)
 
 
        'déplacer le mail dans le fichier inboxWOtraite
        'mail.Move inboxWOtraite
 
    Next mail
 
End Function
 
Private Function Get_sender_SMTP(Oitem As Outlook.MailItem) As String
    Dim oEU As Outlook.ExchangeUser
    On Error Resume Next
    Set oEU = Oitem.Sender.GetExchangeUser
 
    Get_sender_SMTP = oEU.PrimarySmtpAddress
    If Get_sender_SMTP = "" Then Get_sender_SMTP = Oitem.SenderEmailAddress
End Function

06/03/2018, 20h39
cosmic74

Bonsoir Oliv',

J'ai placer ton code tel quel et fait l'appel de la fonction depuis un bouton.
Il me renvoie un champ vide dans le 1er message box.
Et me donne de nouveau l'erreur 287 pour le 2eme message box, dû au mail.CC et aussi au mail.Body
j'ai à nouveau testé le oEU = Oitem.Sender.GetExchangeUser, j'ai également un champ vide.

Avec l'utilisation d'exchange, ne faut il pas lui donner un mot de passe pour y accéder?
J'ai essayer de faire ouvrir la session Outlook juste avant l'appel de la fonction.
Comme je n'ai pas de mot de passe à rentrer apparat celui de la session Windows, je l'ai testé de suite après le démarrage.
Mais rien n'a changé.

Si vous avez d'autres pistes, car là je ne sais plus quoi regarder.
07/03/2018, 10h24
Oliv-

Bonjour,
As tu bien un OUTLOOK fonctionnel ? Si oui pas de problème d'authentification, le programme "ouvre"outlook et c'est Outlook qui fait cela.

j'ai changé le code pour ajouter 2 chose le contrôle du type d'item parce que cela peut être autre chose qu'un Email
et une fonction modifiée pour trouver l'expéditeur dans certains cas quand l'expéditeur n'existe plus dans l'annuaire exchange.

Je ne sais pas ce qu'est l'erreur 287, il faudrait avoir la description, et à quel endroit précis cela s’arrête en cliquant sur débogage
07/03/2018, 21h57
cosmic74

2 pièce(s) jointe(s)

Bonsoir Oliv'

Voici les images des erreurs générées avec ce code.

L'erreur:
Pièce jointe 358013

C'est qu'il ne trouve pas d'information pour mail.CC et mail.Body
Si je les retire de la demande, il boucle en me donnant le titre du mail et son heure de réception

J'ai supprimé la gestion des erreur de ta fonction Get_sender_SMTP est du coup j'obtien l'erreur suivante:
Pièce jointe 358017

Voilà en espérant que ceci puisse t'aidé à comprendre d'où viens mon problème.
Merci encore pour ton temps.

t 'es PJ ne sont pas valides !

oups j'ai oublié de copier mon code

il n'y a rien à changer à mon code !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Function ImporterMailWO()
    Dim appOl As  Outlook.Application
    Dim ns As Namespace
    Dim inboxWOimporte As MAPIFolder
    Dim inboxWOtraite As MAPIFolder
    Dim mail As object
 
    Set appOl = CreateObject("Outlook.Application")
    Set ns = appOl.GetNamespace("MAPI")
    Set inboxWOimporte = ns.GetDefaultFolder(olFolderInbox).Folders("WO importé")
    Set inboxWOtraite = ns.GetDefaultFolder(olFolderInbox).Folders("WO traité")
 
    For Each mail In inboxWOimporte.Items
 
if mail.class = olmail then
 
        MsgBox Get_sender_SMTP(mail)
 
        MsgBox (mail.Subject & vbCr & mail.ReceivedTime & vbCr & mail.CC & vbCr & "#######################################" & vbCr & mail.Body)
 
 
        'déplacer le mail dans le fichier inboxWOtraite
        'mail.Move inboxWOtraite
 end if
    Next mail
 
End Function
 
Function Get_sender_SMTP(Oitem As Outlook.MailItem) As String
    Dim oEU As Outlook.ExchangeUser
    On Error Resume Next
    Set oEU = Oitem.Sender.GetExchangeUser
 
    Get_sender_SMTP = oEU.PrimarySmtpAddress
 
    'si l'expéditeur EXCHANGE n'existe plus dans l'annuaire
    If Get_sender_SMTP = "" Then Get_sender_SMTP = GetFromFromHeader(Oitem)
 
 
    If Get_sender_SMTP = "" Then Get_sender_SMTP = Oitem.SenderEmailAddress
End Function
 
Function GetFromFromHeader(objMail As Outlook.MailItem) As String
'---------------------------------------------------------------------------------------
' Procedure : GetToFromHeader
' Author    : OLIV- from original code brettdj
' Date      : 04/06/2015
' Purpose   :
'---------------------------------------------------------------------------------------
'
    Dim objRegex As Object
    Dim objRegM As Object
    Dim MailHeader As String
    Dim ExtractText As String
    Dim i
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001F"
    MailHeader = objMail.propertyAccessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
 
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .ignorecase = True
        .Pattern = "(\n)From:.*<(.+)>"
        If .test(MailHeader) Then
            Set objRegM = .Execute(MailHeader)
            For i = 0 To objRegM(0).submatches.Count - 1
            If InStr(1, objRegM(0).submatches(i), "@", vbTextCompare) Then
            GetFromFromHeader = objRegM(0).submatches(i)
            Exit For
            End If
            Next i
        Else
            GetFromFromHeader = "No match"
        End If
    End With
End Function

07/03/2018, 22h46
cosmic74

Bonsoir Oliv'

J'ai mis à jour les liens, normalement tu devrais les avoir.

J'ai regardé ton code, je le testerai demain.

Peux tu me donner un peux plus d'information sur:
.Pattern = "(\n)From:.*<(.+)>"
surtout sur la signification de .*<(.+)> car j'ai bien compris que tu recherche la chaîne de caractère "From:" mais la suite je ne comprend pas

et également sur le lien: http://schemas.microsoft.com/mapi/proptag/0x007D001F car il m'indique que la ressource a été supprimer ou renommé dans mon exploreur
07/03/2018, 22h57
Oliv-

pattern...ce sont des paramètres pour les regex

http://cafeine.developpez.com/access/tutoriel/regexp/

Citation:

Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001F"

ce n'est pas un LIEN URL mais un espace de nom
en gros c'est le nom d'une propriété contenu dans les entrailles du mail.