Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Comment récupérer sur Excel, les éléments supprimés d'une Bal générique

Pygos69

XLDnaute Nouveau
Bonjour,

Je coince sur le sujet. J'arrive à récupérer les éléments d'une bal personnelle ainsi que les mails dans éléments supprimés, envoyés et dans des sous-dossiers.

Mais quand il s'agit de bals génériques j'arrive à récupérer les mails dans la boite de réception, mais pas dans les éléments supprimés…

Le dossier des éléments supprimés est = à 3

Voici en vba pour une bal personnelle (éléments supprimés) : =Ok

Sub ElémentsEnvoyés()
Range("A2:d10000").Select
Selection.ClearContents
Selection.ClearComments
Range("A2").Select
Set olapp = CreateObject("Outlook.Application")
Set olns = olapp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(3) ' éléments supprimés
Sheets("LitMessagerie_éléments_suppr").Select
On Error Resume Next
n = 2
For Each I In olxFolder.Items
Cells(n, 1) = I.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(I.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = I.SenderName
Cells(n, 4) = I.CreationTime
n = n + 1
Next
Range("A2").Select

End Sub

et en vba pour une bal générique qui ne fonctionne pas :
olFolderInbox semble incorrect

Sub MessG_Suppr()
Sheets("LitMessagerie_éléments_suppr").Select
Range("A2:d10000").Select
Selection.ClearContents
Selection.ClearComments
Range("A2").Select
Set olapp = CreateObject("Outlook.Application")
Set olns = olapp.GetNamespace("MAPI")
Set sharedemail = olns.CreateRecipient(Sheets("Adresses_mail").Range("B21"))
Set olxFolder = olns.GetSharedDefaultFolder(sharedemail, olFolderInbox)
Sheets("LitMessagerie_éléments_suppr").Select
On Error Resume Next
n = 2
For Each I In olxFolder.Items
Cells(n, 1) = I.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(I.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = I.SenderName
Cells(n, 4) = I.CreationTime
n = n + 1
Next
Range("A2").Select

End Sub

Merci de m'aider à corriger cette erreur…

Bien cordialement,


Excel 2010
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…