[XL-2010] Faire un historique d'email Outlook sous Excel + sauvegarde de pièces jointes

[ozone083]

Bonjour,

Je reçois tous les jours des mails sous Outlook provenant d'un gestionnaire de base documentaire et donc ayant le même format, à savoir :

- Dear ,
You have received a new Workflow Transmittal : lien internet
Project : XXX
Type: XXX
Mail Number: Référence
To: AA, BB, CC
Cc:
From:
Sent: cc/mm/yyyy
Reason:
Status:
Subject: zzzzzzzzzzzz
Uploaded Documents : liste de fichiers

Je sauvegarde ces mails dans un répertoire sous Outlook (nommé Process - cf pièce jointe pour avoir la structure de ma boite mail)

Ce que je souhaiterai faire :

1. créer un fichier Excel dans lequel je sauvegarderai les infos suivantes (une info par cellule, et à chaque mail une ligne) :
- Mail Number,
- Sent
- Subject
- Status

2. créer un répertoire sur mon disque dur (chemin : D:\Boulot\Sauvergarde\) ayant comme nom le Mail Number

3. et ensuite (si c'est possible) sauvegarder les updloaded documents dans le répertoire créer. Le problème est que je dois sélectionner le lien internet afin de pouvoir ensuite récupérer ces uploaded documents.

Concernant le point 1, il Il faudrait, idéalement, que le Mail Number soit un lien hypertexte vers le répertoire ayant le même nom.

Ainsi, au final, en ouvrant le fichier Excel, j'aurai une mise à jour de la liste des emails reçus (avec les infos choisies).
Et en "cliquant" sur le mail number j'accéderai directement aux pièces jointes du-dit mail.

Pour le moment, j'ai réussi à faire le point 2, j'essaie de trouver une solution au point 1 (ai un problème pour accéder au bon répertoire sous Outlook) et ne sais pas du tout comment faire le point 3.

Donc si votre expertise pouvait m'aider cela serait super ; je souhaiterai au moins pouvoir faire le point 1 & 2.

Un grand merci et excellente année 2012 à tous

PS : il faudrait ajouter un test pour éviter de tous recréer à chaque fois (on ne crée le répertoire et on n'archive le mail sous Outlook que si cela n'a pas déjà été fait).

[kiki29]

Salut, à lire : http://excel.developpez.com/faq/?page=Messagerie
http://warin.developpez.com/access/fichiers/

[ozone083]

Je n'arrive pas à trouver mon bonheur sur le forum.
Et comme je suis super débutant, j'ai besoin de trouver vraiment le code équivalent à mon besoin.

J'avais commencé à créer les lignes suivantes afin de récupérer les mails dans le répertoire sous Outlook et ensuite créer le fichier excel avec les infos souhaitées.....mais je n'y arrive pas

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
Private Sub Mails_contactsOutlook()
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Dossier As Outlook.MAPIFolder
Dim Ns As Outlook.Namespace

Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFold erContacts)

Set Ns = olApp.GetNamespace("MAPI")
Set Dossier = Ns.Folders("Projets").Folders("Process") " ça bloque ici car il ne trouve pas le répertoire !!??"

SearchFolders Dossier
End Sub


Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
Dim OLmail As Outlook.MailItem
Dim SousDossier As Outlook.MAPIFolder
Dim c As Range, start As Long, trouv As Long, msg As String
On Error Resume Next
For Each SousDossier In Fld.Folders
If UCase(SousDossier.Name) = "Process" Then
For Each OLmail In SousDossier.Items
a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
Range("A" & a) = OLmail.Subject
Range("B" & a) = OLmail.SenderName
Range("C" & a) = OLmail.CreationTime
Range("D" & a) = OLmail.Body
Next OLmail
SearchFolders SousDossier
End If
Next SousDossier
End Sub

Sub start()
If [A2] <> "" Then Range("A2:B" & Range("B" & Cells.Rows.Count).End(xlUp).Row).Clear
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
Mails_contactsOutlook
[A2].Sort Key1:=[A2], Order1:=xlAscending, Key2:=[B2], Order2:=xlAscending, Header:=xlYes
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With

End Sub