macro qui recupère les accusés de reception sur outlook

Bonjour.
Là, je ne peux pas tester...
Essaie :

Sub LireAR()
Dim OlApp As Object, NS As Object, Dossier As Object
Dim OlExp As Object
Dim m As MailItem, i As Integer
Set OlApp = CreateObject("Outlook.Application")
Set OlExp = OlApp.ActiveExplorer
Set NS = OlApp.GetNamespace("MAPI")
Set Dossier = NS.GetDefaultFolder(olFolderSentMail)
For i = 1 To Dossier.Items.Count
For x = 1 To Dossier.Items(i).Recipients.Count
If Dossier.Items(i).Recipients(x).TrackingStatus = 1 Or _
Dossier.Items(i).Recipients(x).TrackingStatus >= 6 Then
dest = Dossier.Items(i).Recipients(x).Address
If IsNumeric(Application.Match(dest, [A:A], 0)) Then
Range("B" & Application.Match(dest, [A:A], 0)) =
"LU"
End If
End If
Next x
Next i
End Sub

Daniel

Bonjour,

Merci de continuer à travailler sur cette macro. C'est vraiment sympa de ta
part.
Effectivement, il s'agira d'un mailing et il y aura donc plusieurs
destinataires par envois.

Merci à toi

JBF

Bonjour,
je n'ai pas encore pu tester ta macro mais je pense le faire cet aprem.
Je te tiens au courant.

merci
JBF

"Daniel.C" <dcolardelleZZZ@free.fr> a écrit dans le message de news:
%2331lAoyQJHA.5064@TK2MSFTNGP03.phx.gbl...

Bonjour.
Là, je ne peux pas tester...
Essaie :

Sub LireAR()
Dim OlApp As Object, NS As Object, Dossier As Object
Dim OlExp As Object
Dim m As MailItem, i As Integer
Set OlApp = CreateObject("Outlook.Application")
Set OlExp = OlApp.ActiveExplorer
Set NS = OlApp.GetNamespace("MAPI")
Set Dossier = NS.GetDefaultFolder(olFolderSentMail)
For i = 1 To Dossier.Items.Count
For x = 1 To Dossier.Items(i).Recipients.Count
If Dossier.Items(i).Recipients(x).TrackingStatus = 1 Or _
Dossier.Items(i).Recipients(x).TrackingStatus >= 6 Then
dest = Dossier.Items(i).Recipients(x).Address
If IsNumeric(Application.Match(dest, [A:A], 0)) Then
Range("B" & Application.Match(dest, [A:A], 0)) = "LU"
End If
End If
Next x
Next i
End Sub

Daniel

Bonjour,

Merci de continuer à travailler sur cette macro. C'est vraiment sympa de
ta part.
Effectivement, il s'agira d'un mailing et il y aura donc plusieurs
destinataires par envois.

Merci à toi

JBF

Bonjour,

J'ai deux questions pour l'optimisation de ta macro:

1°/ Peut-on ajouter une ligne à la macro pour que ça rapporte uniquement les
AR en fonction de l'intitulé de l'objet du mail?
Genre, Si objet = "test mailing" alors relever les AR sinon ignorer les AR.

2°/ Comment se fait-il que lorsque j'ai supprimé (SHIFT + SUPPR) les AR de
la BTE DE RECEPTION ainsi que des ELEMENTS SUPPRIMES la macro me met tt de
même "LU" en face des adresses mails pour lesquelles j'avais effectivement
reçu un AR mais que j'ai déjà définitivement supprimé?

Merci

JBF


"Daniel.C" <dcolardelleZZZ@free.fr> a écrit dans le message de news:
%2331lAoyQJHA.5064@TK2MSFTNGP03.phx.gbl...

Bonjour.
Là, je ne peux pas tester...
Essaie :

Sub LireAR()
Dim OlApp As Object, NS As Object, Dossier As Object
Dim OlExp As Object
Dim m As MailItem, i As Integer
Set OlApp = CreateObject("Outlook.Application")
Set OlExp = OlApp.ActiveExplorer
Set NS = OlApp.GetNamespace("MAPI")
Set Dossier = NS.GetDefaultFolder(olFolderSentMail)
For i = 1 To Dossier.Items.Count
For x = 1 To Dossier.Items(i).Recipients.Count
If Dossier.Items(i).Recipients(x).TrackingStatus = 1 Or _
Dossier.Items(i).Recipients(x).TrackingStatus >= 6 Then
dest = Dossier.Items(i).Recipients(x).Address
If IsNumeric(Application.Match(dest, [A:A], 0)) Then
Range("B" & Application.Match(dest, [A:A], 0)) = "LU"
End If
End If
Next x
Next i
End Sub

Daniel

Bonjour,

Merci de continuer à travailler sur cette macro. C'est vraiment sympa de
ta part.
Effectivement, il s'agira d'un mailing et il y aura donc plusieurs
destinataires par envois.

Merci à toi

JBF