Extraire données mails Outlook vers Excel

**Dheimoss** · 15/03/2012, 16h58

J'aimerai adapté cette macro afin d'en reprendre certains aspects. Mais j'ai quelques questions concernant des erreurs que j'obtiens, pourriez-vous s'il vous plait m'accorder quelques minutes?

Voici mes questions :

- Le morceau de code permettant compter les lignes du classeur "Ligne = .Cells(.Rows.Count, 3).End(xlUp).Row" me renvoie une erreur, j'ai tenté une autre technique avec une Selection.down mais la valeur qui ressort de la macro n'est pas la bonne, j'ai fini par le remplacé par une valeur fixe dans le cadre du test de la macro mais en automatique c'est mieux.
- La macro une fois modifié a mon souhait (je n'ai pas besoin du corps de texte du mail mais juste auteur objet et date) s’exécute parfaitement bien, il subsiste un bug que je comprend pas, seulement un nombre aléatoire de mail sont traités (de 1 a 20 sur 20 mail à croire que le nombre d'items du dossier n'est pas la bonne), ce qui m'oblige a faire tourner la macro plusieurs fois. Auriez-vous une idée de pourquoi cela se produit?

Je vous remercies d'avance du temps que vous pourrez m'accorder.
Cordialement,

**Daniel.C** · 15/03/2012, 17h14

Bonjour,

Est-ce que tu peux, s'il te plait, poster le code auquel tu te réfères, apparemment, je ne retrouve pas cette ligne. Précise également ta version d'Excel.

**Dheimoss** · 15/03/2012, 18h08

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub LireMessagesDUnDossierEtLeDeplacerVersUnAutre()
    'Réf.sdispro.xlsm
    Dim olApp As Object, NS As Object, Dossier As Object
    Dim DossierDest As Object, DossierCible As Object
    Dim i As Object, x As Long, R As Object, Ligne As Long
    Set olApp = CreateObject("Outlook.Application")
    Set NS = olApp.GetNamespace("MAPI")
    Set DossierSource = NS.Folders(1).Folders("Boîte de réception").Folders("essai")
    Set DossierDest = NS.Folders(1).Folders("Boîte de réception").Folders("traiter")
    Ligne = .Cells(.Rows.Count, 3).End(xlUp).Row
    With Sheets("Feuil1")
        For Each i In DossierSource.Items
            Ligne = Ligne + 1
            .Cells(Ligne, 1) = i.sendername
            .Cells(Ligne, 2) = i.Subject
            Ligne = Ligne + 1
            For x = 0 To UBound(Split(i.Body, vbCrLf))
                Ligne = Ligne + 1
                .Cells(Ligne, 3) = Split(i.Body, vbCrLf)(x)
            Next x
            '.range(.[A2],.cells(ligne+1,3)).
            .Columns(3).AutoFit
 
            'sauvegarde du message sous forme de fichier. Possibilité de mettre un lien hypertexte pour l'ouvrir dans Outlook
            'i.SaveAs "c:temp\" & Format(i.CreationTime, "yyyy-mm-dd hh""h""mm") & " - " & i.Subject & ".msg", olMSG
            i.Move DossierDest
        Next i
    End With
    Set NS = Nothing
    Set olApp = Nothing
 
End Sub

Pour la première erreur, je parle de ce code la que tu as posté un peu plus haut et spécifiquement de la ligne en rouge.

J'utilise excel 2010&2007 et outlook 2010.

Si je peux abuser de tes services, j'ai lié en PJ, le résultat final que j'aimerai obtenir. Mais je ne sais pas comment récupérer les PJ (les stocker dans un dossier X et les afficher avec lien dans le excel) et comment faire apparaître si il y a doublon (le nom de la personne est obligatoirement dans l'objet du mail, j'ai établit un format obligatoire avec mes sous-traitants).
De même la formule pour l'entreprise est assez chiante dans la mesure ou certaine entreprise ont 4-5 sources qui m'envoie leur CV et je manage sur 8 entreprise donc ca fera une longue formule (mais je la ferai si y'a pa un trick)

Allez j'abuse vraiment pour la colonne poste même, les entreprises sont censés suivre un format, parfois elle me mettent PDEF ou DEV directement à la place Product Definition ce qui fait bugguer la formule du coup.

Merci pour tout aide que tu pourrais me fournir, sachant que la priorité reste sur la fonctionnalité de base qui fonctionne a moitié (pas tout les mail sont traités).

**Dheimoss** · 15/03/2012, 18h24

J'abuse vraiment mais me forcer à écrire mes fonctionnalités m'a fait pensé à une utopie que j'ai depuis longtemps.

J'ai rajouté une colonne et dans l'onglet mail les détails, mais le but serait de sortir un mail récap statut à partir d'une date X de façon automatisé.

Si t'arrives m'aider sur ca je m'incline très bas !

**Daniel.C** · 15/03/2012, 21h39

Il y avait une erreur dans la façon de traiter les mails. Rectifié. Si, sur Sheet2, tu mets une table des auteurs et des entreprises, tu peux mettre en B2, à recopier vers le bas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(A2="";"";RECHERCHEV(A2;Sheet2!F:G;2;0))

De même, en G2, à recopier vers le bas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(NB.SI($E$2:E2;E2)>1;"Oui";"Non")

Tu mets une MEFC sur la colonne avec la formule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=G2="oui"

mise en forme : police rouge.
La macro devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub LireMessagesDUnDossierEtLeDeplacerVersUnAutre2()
    'Réf.test macro2.xlsm
    Dim olApp As Object, NS As Object, Dossier As Object
    Dim DossierDest As Object, DossierCible As Object
    Dim i As Object, x As Long, R As Object, Ligne As Long
    Set olApp = CreateObject("Outlook.Application")
    Set NS = olApp.GetNamespace("MAPI")
    Set DossierSource = NS.Folders(1).Folders("Boîte de réception").Folders("essai")
    Set DossierDest = NS.Folders(1).Folders("Boîte de réception").Folders("traiter")
    With Sheets("Sheet1")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Do
            If DossierSource.Items.Count = 0 Then Exit Sub
            Ligne = Ligne + 1
            .Cells(Ligne, 1) = DossierSource.Items(1).sendername
            .Cells(Ligne, 3) = DossierSource.Items(1).Subject
            .Cells(Ligne, 4) = DossierSource.Items(1).ReceivedTime
'            For x = 0 To UBound(Split(i.Body, vbCrLf))
'                Ligne = Ligne + 1
'                .Cells(Ligne, 3) = Split(i.Body, vbCrLf)(x)
'            Next x
            '.range(.[A2],.cells(ligne+1,3)).
            .Columns(3).AutoFit
 
            'sauvegarde du message sous forme de fichier. Possibilité de mettre un lien hypertexte pour l'ouvrir dans Outlook
            'i.SaveAs "c:temp\" & Format(i.CreationTime, "yyyy-mm-dd hh""h""mm") & " - " & i.Subject & ".msg", olMSG
            DossierSource.Items(1).Move DossierDest
        Loop
    End With
    Set NS = Nothing
    Set olApp = Nothing
 
End Sub

Regarde le classeur joint. Si tu ne peux pas lire les fichiers rar, dis-le.

**Dheimoss** · 15/03/2012, 23h34

Merci bien !

Je test ca demain au boulot,
Une idée sur le faisabilité de mon deuxième message? Et du stockage des PJ ?

**Daniel.C** · 16/03/2012, 11h51

Bonjour,
La macro suivante traite le stockage des pièces jointes dans le dossier indiqué dans la variable "Chemin". Le format de nom des pièces jointes est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

aaaa-mm-jj hh.mm.ss NomduFichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub LireMessagesDUnDossierEtLeDeplacerVersUnAutre()
    'Réf.test macro2.xlsm
    Dim olApp As Object, NS As Object, Dossier As Object
    Dim DossierDest As Object, DossierCible As Object
    Dim i As Integer, x As Long, R As Object, Ligne As Long
    Dim Chemin As String, Sh As Worksheet
    Chemin = "C:\temp\"
    Set olApp = CreateObject("Outlook.Application")
    Set NS = olApp.GetNamespace("MAPI")
    Set DossierSource = NS.Folders(1).Folders("Boîte de réception").Folders("essai")
    Set DossierDest = NS.Folders(1).Folders("Boîte de réception").Folders("traiter")
    Set Sh = Sheets("Sheet1")
    Do
        If DossierSource.Items.Count = 0 Then Exit Sub
        With DossierSource.Items(1)
            Ligne = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
                Ligne = Ligne + 1
                Sh.Cells(Ligne, 1) = DossierSource.Items(1).sendername
                Sh.Cells(Ligne, 3) = DossierSource.Items(1).Subject
                Sh.Cells(Ligne, 4) = DossierSource.Items(1).ReceivedTime
                Sh.Columns(3).AutoFit
 
            'extraction des pièces jointes
            If .Attachments.Count > 0 Then
                For i = 1 To .Attachments.Count
                    .Attachments(i).SaveAsFile Chemin & Format(Now, "yyyy-mm-dd hh.mm.ss") & " " & .Attachments(i).Filename
                Next i
            End If
            'sauvegarde du message sous forme de fichier. Possibilité de mettre un lien hypertexte pour l'ouvrir dans Outlook
            'i.SaveAs "c:temp\" & Format(i.CreationTime, "yyyy-mm-dd hh""h""mm") & " - " & i.Subject & ".msg", olMSG
            .Move DossierDest
        End With
    Loop
    Set NS = Nothing
    Set olApp = Nothing
 
End Sub

De cette façon, on devrait éviter les doublons. Faut-il prévoir une colonne pour les lister avec les messages ? Peux-tu détailler ce que tu veux sur la récap, le formulaire tel qu'il est à vide ? Est-ce qu'il faut le remplir à partir des listes déroulantes ?
Pour la colonne "Statut", en H2 et à recopier vers le bas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(NB.SI(E:E;E2)=1;"OK";SI(ET(NB.SI(E:E;E2)>1;NB.SI($E$2:E2;E2)=1);"KO";"Doublon"))

**Dheimoss** · 28/03/2012, 12h15

Désolé pour le délai de réponse, j'ai été embarqué sur quelque chose au boulot et je n'ai pas eu le temps de te répondre.

Merci pour la macro, j'ai pu l'adapté pour faire en partie ce que je voulais.

Pour le recap le but est de récupérer les infos à partir d'une date et de les envoyer directement aux entreprises souhaités.

Ex : Faire un recap du screening du lundi 26/03 à la société 1.
Le recap affiche donc les CV de la société 1 avec leur statut et un bouton permet de l'envoyer par mail directement.

Mais le projet actuel va évoluer car j'ai négocié un espace sharepoint plutôt que ma base de données excel.

Néanmoins serais-tu aussi expert dans l'extraction de données via un sharepoint directement dans une macro excel (afin de continuer à traiter la miriade de KPIs que j'ai pu mettre en place via excel)?
Si oui, me permet-tu de revenir vers toi lorsque que le projet sera mise en place?

**Daniel.C** · 28/03/2012, 12h43

Bonjour,

Non, hélas, je n'ai jamais touché à SharePoint.

**Dheimoss** · 28/03/2012, 14h19

Ok dommage :p mais en tout cas merci à toi, c'est très plaisant d'avoir un interlocuteur réactif en plus d'être compétent

Extraire données mails Outlook vers Excel

Macros et VBA Excel

Discussions similaires

Partager

Partager