extraction corps d'un mail dans un TXT

Question

Bonjour,

Je suis novice dans la prog et je bloque sur un script que j'essaie de realiser qui permet d'extraire le texte contenu dans un mail outlook (d'un sous dossier bien particulier) et de l'ecrire dans un fichier texte puis enfin de le supprimer (dans les element supprimes de outlook).

J'arrive a faire des choses mais le probleme est lorsqu'il y a plusieur mails mons script se plante avec l'erreur : ligne 16 caract 2 erreur index de la matrice en dehors des limites code 80020009 source Microsoft office outlook (j'utilise office 2K3).

voici mon code :
Const ForReading 1, ForWriting 2
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set objol = CreateObject("outlook.application")
Set olfolder = objol.GetNamespace("MAPI").Folders("dossiers personnels")
Set olfolder = olfolder.Folders("boîte de réception")
Set olfolder = olfolder.Folders("compteurs")
Set olfolderitems = olfolder.items
numitems = olfolderitems.Count
Set f = fso.CreateTextFile("C:\compteurs kyo\recup mails.txt", ForWriting, True)
For I = 1 To numitems
'on error resume next
 Set olmyitem = olfolderitems(I)
 contenumail = olmyitem.body
 f.write (contenumail)
 olmyitem.Delete
next

avec ce code j'extrais et supprime 4 mails et lorsque je decommente la ligne on error resume next, tous les mails sont bien dans mon fichier texte mais seuleument 4 sont supprimés.

Please help me because je tourne en rond et je ne vois pas de soluce!!!

Merci d'avance.

NAMZAT

namzat · Answer

J'ai trouvé ma solution tout seul comme un grand !!!
c'etait tout con car en fait comme je suprime les mails au fur et a mesure, arrivé a un moment il cherche a suprimer les mail n°6 alors qu'il n'y en a plus que 4 dans le dossier donc erreur....

voici donc mon code final pour ceux que ca interresse :
Const ForReading 1, ForWriting 2
Dim fso, f
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
Set objol = CreateObject("outlook.application")
Set olfolder = objol.GetNamespace("MAPI").Folders("dossiers personnels")
Set olfolder = olfolder.Folders("boîte de réception")
Set olfolder = olfolder.Folders("compteurs")
Set olfolderitems = olfolder.items
numitems = olfolderitems.Count
Set f = fso.CreateTextFile("C:\compteurs kyo\recup mails.txt", ForWriting, True)
For I = 1 To numitems
 Set olmyitem = olfolderitems(numitems - I + 1)
 contenumail = olmyitem.body
 f.write (contenumail)
 olmyitem.Delete
next

Voilou
Je tiens a dire que j'ai repris une source existante de 
http://www.vbfrance.com/auteur/FLORIAN138/34613.aspx,  florian138

en y rajoutant la supression automatique des mails extraits.

J'attend vos commentaires...

Extraction corps d'un mail dans un TXT

1 réponse

Votre réponse

Discussions similaires