Extraire les pièces jointes à partir des archives outlook

Bonjour à tous,

J'ai un peu le même besoin que "ivanG" dans cette discussion sauf que dans mon cas je souhaite récupérer les pièces jointes à partir des archives outlook, je vous explique !
J'ai un dossier dans lequel j'ai stocké une liste de mail (fichiers .msg) et dans chacun il y'a un fichier excel.
Donc ce que je veux faire c'est récupérer toutes les pièces jointes et les enregistrer par la suite dans un autre dossier.

Je suis vraiment nulle en VBA vue que c'est la première fois que travaille avec, donc j'ai essayé plusieurs code que j'ai trouvé sur internet mais aucun d'entre n'a fonctionné :/.

Pouvez-vous m'aider SVP ?

Bonjour,

Quand tu parles de dossier, tu veux dire sur le disque dur (ou réseau) ?
Si oui, qu'est-ce que tu fais s'il y a plusieurs fichiers avec le même nom ?

Re bonjour,


Quand tu parles de dossier, tu veux dire sur le disque dur (ou réseau) ?
=> c'est sur le réseau
Si oui, qu'est-ce que tu fais s'il y a plusieurs fichiers avec le même nom ?
=> le nommage ressemble à ça : rapport01062014.msg (la date change )

En fait, je parlais des fichiers joints aux messages.
S'ils peuvent avoir le même nom d'un message à l'autre, ça causera une erreur.
Il faudrait alors lui ajouter un chiffre ou quelque chose comme ça...

Non, au fait c'est la même chose dans les fichiers ça change en fonction de la date

Je fais une vérification que ce sont bien des messages .MSG
Ensuite, je vérifie l'extension pour ne copier que les fichiers Excel.
S'il y a d'autres types de fichiers, change la condition.

Il faut savoir que s'il y a des images dans le message (signature ou autre...), elles seront copiées aussi...

Il te reste à inscrire les chemins des fichiers MSG et de destination.
Nul besoin de référence à Outlook.

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

Sub SaveMSG() Dim objOL As Object Dim objItem As Object Dim Attach As Object, NomFichier As String Dim CheminMSG As String, CheminDest As String Dim Fichier As Variant CheminMSG = "Chemin des fichiers MSG" If Right(CheminMSG, 1) <> "\" Then CheminMSG = CheminMSG & "\" CheminDest = "Chemin de destination" If Right(CheminDest, 1) <> "\" Then CheminDest = CheminDest & "\" Set objOL = CreateObject("Outlook.Application") Fichier = Dir(CheminMSG, vbArchive) Do While LCase(Right(Fichier, 3)) = "msg" 'vérifie que ce sont bien des .MSG Set objItem = objOL.CreateItemFromTemplate(CheminMSG & Fichier) For Each Attach In objItem.Attachments 'lecture de tous les fichiers joints NomFichier = Attach.Filename 'Copie les fichiers Excel seulement If InStr(1, NomFichier, ".xls") > 0 Then Attach.SaveAsFile CheminDest & NomFichier Next Fichier = Dir Loop Set objItem = Nothing Set objOL = Nothing End Sub

---

Super ! ça marché :)

Merci beaucoup

Bonjour à tous,

Je voudrais savoir s'il y'a un moyen d'ajouter un champ dans la première feuille de chaque fichier avec le nom du fichier.

J'ai essayé sur un seul fichier avec la commande suivante :

Sheets(1).Range("N1").Value = ActiveWorkbook.Name

ça a marché ! mais le soucis que j'arrive pas à le faire avec tout une liste de fichiers :(

et au même temps je veux récupérer juste la première feuille de mes classeurs, donc j'ai ajouté au programme de "parmi" ces deux lignes de code:
Sheets(2).Delete
Sheets(3).Delete
il m'affiche pas d'erreur mais ces feuilles ne sont pas supprimées !


Pourriez vous m'orienter svp ?

Merci d'avance !

Je te conseillerais d'ouvrir un nouveau sujet.
Comme celui-ci est marqué "résolu", plusieurs ne s'y arrêteront pas...

D'accord, merci :)