Discussion :

[neuTh]

Bonjour

J'ai récupéré une macro vba pour outlook mais je pense qu'elle est pour les versions pc/win

Est ce possible d'utiliser ce script avec Applescript s'il vous plaît ?

Il s'agit d'un script pour extraire la totalité des adresses mails de tous les mails reçus, envoyés et dans le corps des mails.

Si je vous montre le script, quelqu'un pourrait il m'expliquer comment le lancer afin qu'il génére la fameuse liste excel de toutes les adresses mails possibles ?

Merci pour votre aide précieuse
Cordialement
Pierre

[PBELL]

Bonjour,
La majorité des instructions VBA sont identiques entre Mac et PC. Les principales différences se situent dans le traitement des fichiers (open, save, save as,...).

Si ton script récupère les adresses des mails Outlook pour en faire une liste Excel, il devrait donc y a voir peu des ces instructions.
Je pense donc que ta macro VBA devrait fonctionner telle qu'elle est à 90%. Difficile à dire sans voir le VBA...

Sinon, en lisant le dictionnaire Applescript des instruction Outlook, récupérer les adresses des emails via Applescript pour en faire une liste dans Excel semble tout à fait faisable.
J'ai un script similaire pour Mail et les instructions sont visiblement de même type.

Cordialement

[neuTh]

Voici le script ( il est opensource, de inpec pour le citer, par respect )

Comment le lancer dans applescript pour qu'il génère le fichier excel avec toutes les adresses mails s'il te plaît?

Code VBA :

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
'GetMail V4.1
'DÈclaration des tableaux dynamiques globaux contenant la liste des emails
Dim eMails(), noms() As String
Dim EmailFromBody As Boolean
Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
'Extrait dans Outlook la liste des emails (destinataire, Èmetteur, corp) du dossier sÈlectionnÈ
'et crÈe un mail avec la liste des emails
Sub GetEmail()
    Set rep = Outlook.Application.ActiveExplorer.CurrentFolder
'   Set rep = Application.Session.CurrentFolder
    ' initialisation du tableau
    reponse = MsgBox("Voulez-vous extraire les e-mails du corp des messages ?", vbYesNoCancel)
    If reponse = vbCancel Then
      Exit Sub
    ElseIf reponse = vbYes Then
      EmailFromBody = True
    Else
      EmailFromBody = False
    End If
    ReDim Preserve eMails(1), noms(1)
    eMails(1) = ""
    noms(1) = ""
    'On stocke les emails dans le tableau
    GetEmailFromFolder rep
    If eMails(1) <> "" Then
        NomFichier = GetTempDir2() & "/emails.xls"
        Close #1
        Open NomFichier For Output As #1
            For i = 1 To UBound(eMails)
                Print #1, AfficheEmail(noms(i), eMails(i))
            Next
        Close #1
        MsgBox UBound(eMails) & " emails trouvÈs dans " & rep, vbInformation, "Done"
        OpenExcel2 (NomFichier)
    Else
        MsgBox "Pas d'email trouvÈ dans " & rep, vbInformation, "Done"
    End If
 
End Sub
Function AfficheEmail(nom, Email)
    Email = Replace(Email, "'", "")
    If nom = "" Or nom = "body" Then
       nom = Email
    End If
    AfficheEmail = Email + vbTab + nom + vcrlf
End Function
'Explore les dossiers (fonction rÈentrante)
Sub GetEmailFromFolder(myFolder)
    Dim myItemRec, MyItem As Object
    Dim myMailItem As Outlook.MailItem
    'Tous les dossiers
    For Each MyItem In myFolder.Folders
            GetEmailFromFolder MyItem
    Next
    'Tous les mails
    rep = Replace(myFolder.FolderPath, "\", vbTab)
    'rep = Replace(myFolder, "\", vbTab)
 
    'On Error Resume Next
    For Each MyItem In myFolder.Items
        If TypeName(MyItem) = "MailItem" Then
            'Destinataires (cc & cci)
            For Each myItemRec In MyItem.Recipients
                addMail myItemRec.name & vbTab & "dest" & rep, myItemRec.Address
            Next
            'Emetteur
            addMail MyItem.SenderName & vbTab & "exp" & rep, MyItem.SenderEmailAddress
            'et dans le corp du mail
           If EmailFromBody Then findMail MyItem.body, rep
 
        End If
    Next
End Sub
'Rajoute une entrÈe au tableau emails() si l'email n'existe pas dÈj‡
Sub addMail(nom, Email)
    Email = TrimEmail(Email)
    nom = Trim(nom)
    If Email <> "" And InStr(Email, "@") > 0 And InStr(Email, ".") > 0 Then
        'VÈrification de l'unicitÈ
        Find = UBound(Filter(eMails, Email, True, vbTextCompare))
        If eMails(1) = "" Then
            eMails(1) = Email
            noms(1) = nom
        ElseIf Find = -1 Then
            'On augmente la taille du tableau et on ajoute
            ReDim Preserve eMails(UBound(eMails) + 1)
            ReDim Preserve noms(UBound(noms) + 1)
            eMails(UBound(eMails)) = Email
            noms(UBound(noms)) = nom
        Else
            'On prÈfËre le plus grand si c'est pas une email
            If Len(nom) > Len(noms(Find)) And InStr(nom, "@") = 0 Then
                noms(Find) = nom
            End If
        End If
    End If
End Sub
Sub findMail(body, rep)
    at = InStr(body, "@")
    Do While at > 1
        D = at - 1
        Do While carOk(Mid(body, D, 1))
            D = D - 1
            If D = 0 Then
               Exit Do
            End If
        Loop
        f = at + 1
        Do While carOk(Mid(body, f, 1))
            f = f + 1
            If f = Len(body) Then
               Exit Do
            End If
        Loop
        If D < at - 3 And f > at + 4 Then
            addMail GetTel(body) & vbTab & "body" & rep, Mid(body, D + 1, f - D - 1)
        End If
        at = InStr(at + 1, body, "@")
    Loop
End Sub
Function carOk(c)
    If c = "." Or c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Or (c >= "a" And c <= "z") Then
        carOk = True
    Else
        carOk = False
    End If
End Function
Function carOkDebut(c)
    If c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "a" And c <= "z") Then
        carOkDebut = True
    Else
        carOkDebut = False
    End If
End Function
Function carOkFin(c)
    If (c >= "a" And c <= "z") Then
        carOkFin = True
    Else
        carOkFin = False
    End If
End Function
Function TrimEmail(email_ini)
  Email = Trim(LCase(email_ini))
  D = Len(Email)
  For i = 1 To D
    If Not carOkDebut(Left(Email, 1)) Then
      Email = Mid(Email, 2, Len(Email) - 1)
    Else
      Exit For
    End If
  Next i
  D = Len(Email)
  For i = 1 To D
    If Not carOkFin(Right(Email, 1)) Then
      Email = Mid(Email, 1, Len(Email) - 1)
    Else
      Exit For
    End If
  Next i
  TrimEmail = Email
End Function
Function GetTel(body)
  Static Reg As Object
  If Reg Is Nothing Then
    Set Reg = CreateObject("vbscript.regexp")
    Reg.Global = True
    Reg.IgnoreCase = True
    Reg.MultiLine = True
  End If
  Reg.Pattern = "([a-zA-ZÈ]*)[+ :]*?(([-. ]?[0-9]){10,11})"
  Set Matches = Reg.Execute(body)
  GetTel = ""
  For Each Match In Matches
      GetTel = GetTel & Match.Value & ";"
  Next Match
 
End Function
 
Sub OpenExcel2(FileName)
    Set xls = CreateObject("Excel.Application")
    xls.Workbooks.Open FileName
    xls.Visible = True
End Sub
Function GetTempDir2() As String
    Dim buffer As String * 256
    Dim Length As Long
    Length = GetTempPath(Len(buffer), buffer)
    GetTempDir2 = Left(buffer, Length)
End Function

[neuTh]

Dans l'éditeur de script, dans le menu fenêtre, bibliothèque, j'ai ajouté l'application Outlook 2016

Fichier, nouveau
J'ai collé le script ci-dessus et je l'ai lancé...
Ca ne fait rien ...
Peut-être faut-il modifier légèrement le script pour qu'il fonctionne sur mac, sur ma version de Outlook 2016, qu'il lance et génère le fichier sur le bon Excel.

Serais-tu en mesure de me le modifier s'il te plaît afin que ça fonctionne ?

Merci pour ton aide

[PBELL]

Bonjour,
Tout d'abord, ton script VBA est du VBA et pas de l'Applescript, donc le copier/coller dans l'éditeur de script ne doit rien donner sauf une multitude d'erreurs de syntaxe.
Il me semble que tu confonds les 2 languages :
- VBA ne peut s'exécuter que dans le cadre une macro Microsoft
- l'Editeur de Script ne peut complier que des scripts en Applescript ou Javascript.

Si j'ai bien compris, tu a mis le script VBA dans l'éditeur de script...donc ça ne peut fonctionner.
Je n'ai pas Outlook 2016, aussi je ne peux tester le copier/coller de ton VBA dans une macro Outlook, mais c'est la première chose à faire.
Cependant, le début de ton script VBA contient :

Code :

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

Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

...et je ne suis pas sûr de ce que cela fait : il me semble que cela déclare une fonction extraite d'une librairie "Kernel32" qui n'existe peut être pas sur Mac.
Pour le reste des instructions VBA, je ne vois rien qui mérite d'être changé sur Mac, à condition toujours que le VBA soit dans une macro Outlook et pas un Applescript.
Le mieux serait de chercher support auprès de Inpec.

Cependant, j'ai l'impression que ce script VBA fait bien plus que simplement lister les adresses des emails dans un dossier Outlook sélectionné:
- il décode et extrait des numéros de tel,
- il fait de la recherche de ce qui pourrait ressembler à une adresse email dans le corps du texte des emails avec analyse de la validité de l'adresse.

Par ailleurs, je ne suis pas spécialiste Outlook, mais il mets les adresses trouvées dans un mail Outlook et, pour chaque nouvelle adresse vérifie les doublons. Il me semblerai plus rapide et simple de mettre les adresses directement dans Excel, puis, à la fin, de demander à Excel de supprimer les doublons en une seule instruction.

Cordialement

[neuTh]

Merci pour ta réponse complète PBELL

C'est bien ce que je pensais, ce script est prévu pour Windows avec un lancement direct dans Outlook et non un script qui peut être lancé par applescript.

Je pense qu'il serait donc plus judicieux d'utiliser par exemple ton script disponible pour le logiciel 'Mail' et le rendre fonctionnel pour Outlook 2016.
Penses tu que tu pourrai me le fournir s'il te plaît ?

L'idée est donc d'extraire les adresses mails des mails reçus, envoyés et dans le corps des mails.
Générant un fichier Excel avec toutes les adresses.
Et ensuite dans Excel, comme suggèré, supprimer les doublons ou triplons voir davantage.

Merci pour ton aide et retour
Cordialement
Pierre

[PBELL]

Bonjour,
J'ai adapté mon Applescript pour Outlook (j'ai ré-installé une vieille version 2011 qui allait avec mon Pack Excel pour pouvoir tester).

Le script détecte si des emails sont sélectionnés et si oui, il traite ces emails.
Si aucun email n'est sélectionné directement, le script prend tous les emails du dosser sélectionné. J'ai testé avec le dossier "envoyés" et avec des emails directement, mais tu dois aussi tester avec d'autres types de dossiers Outlook.

Ensuite pour chaque email, le script extrait les adresses emails des destinataires (direct, copie, ...) ainsi que les adresses qui pourraient se trouver dans le corps texte du mail.
Le résultat est collé dans une feuille vierge Excel, en colonne.
Par contre, je n'ai pas trouvé comment lancer, via script, la commande de suppression des doublons. Curieusement, l'enregistrement de cette commande dans une macro VBA ne donne rien ! Apparement, cette fonction ne peut être appelée ...?! (si quelqu'un a la solution, je prends !).

Voici ce script avec plein de commentaires. Tu peux le copier dans l'éditeur Applescript et le lancer après avoir ouvert Outlook et sélectionné des emails ou un dossier dans Outlook.

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
38
39
40
41
42
43
-- récupère les adresses emails dans les emails sélectionnés
set ListeAdresses to {}
tell application "Microsoft Outlook"
    set maListe to selected objects--des emails sont selectionnés
    if (count of maListe) = 0 then -- pas d'emails sélectionnés donc on prend tous les emails du dossier sélectioné
        set monDossier to selected folder
        set maListe to every message of monDossier
    end if
    
    repeat with I from 1 to count of maListe
        tell me to set mesAdr to GetEmail(content of itemI of maListe) -- récupère les emails dans le corps du texte
        set DestListe to every recipient of itemI of maListe-- lit la liste de tous les recipients (incl. to, cc et bcc)
        repeat with J from 1 to count of DestListe
            set monAdresse to email address of item J of DestListe
            set end of mesAdr to (address of monAdresse) -- ajoute l'adresse en fin de liste
        end repeat
        set ListeAdresses to ListeAdresses & mesAdr-- ajoute la liste des adresses de cet email dans la liste generale
    end repeat
end tell
-- converti la liste en texte avec une adresse par ligne
set AppleScript'stext item delimiters to {return}
set the clipboard to ListeAdresses as text-- mets le text dans le presse papier


tell application "Microsoft Excel" -- cree un nouveau document Excel et colle le texte.
make new document
activate
    tell active sheet to paste
end tell




on GetEmail(Tsource) -- extrait la liste des adresses emails contenues dans le texte
    set myList to {}
    set AppleScript'stext item delimiters to "@"
    set Parts to text items of Tsource
    set AppleScript's text item delimiters to {space, linefeed, return, tab, quote, character id 160, "<", ">", "?", "!", ":", ";", "(", ")"}
    repeat with I from 2 to count of Parts
        set end of myList to (text item -1 of item (I - 1) of Parts) & "@" & (text item 1 of item I of Parts)
    end repeat
    return myList
end GetEmail

Un dernier commentaire : si tu as des milliers d'emails, il se peut que la gestion par liste devienne lourde pour Applescript. Dans ce cas, le plus simple serait d'enregistrer les adresses sous formes de lignes dans un fichier texte. Avec cette méthode, pas de limite !

Cordialement

[neuTh]

Bonjour PBELL

Merci beaucoup pour ce script.

Dans apple script, fenêtre, bibliothèque, je sélectionne Outlook 2016
Fichier, nouveau, je colle ton script et le lance
J'ai un message d'erreur :
error "Il est impossible d’obtenir itemI of {incoming message id 207263 of application \"Microsoft Outlook\"}." number -1728 from itemI of {«class inm » id 207263}

Outlook 2016 est bien ouvert et j'ai sélectionné un petit dossier de mails reçus, 2000 mails

Quel serait le problème s'il te plaît?

Petite précision je n'arrive pas à copier le script avec les numéros de 1 à 43 sur le côté gauche

Je n'arrive qu'à coller le script de cette façon :

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
38
39
-- récupère les adresses emails dans les emails sélectionnés
set ListeAdresses to {}
tell application "Microsoft Outlook"
    set maListe to selected objects--des emails sont selectionnés
    if (count of maListe) = 0 then -- pas d'emails sélectionnés donc on prend tous les emails du dossier sélectioné
        set monDossier to selected folder
        set maListe to every message of monDossier
    end if
 
    repeat with I from 1 to count of maListe
        tell me to set mesAdr to GetEmail(content of itemI of maListe) -- récupère les emails dans le corps du texte
        set DestListe to every recipient of itemI of maListe-- lit la liste de tous les recipients (incl. to, cc et bcc)
        repeat with J from 1 to count of DestListe
            set monAdresse to email address of item J of DestListe
            set end of mesAdr to (address of monAdresse) -- ajoute l'adresse en fin de liste
        end repeat
        set ListeAdresses to ListeAdresses & mesAdr-- ajoute la liste des adresses de cet email dans la liste generale
    end repeat
end tell
-- converti la liste en texte avec une adresse par ligne
set AppleScript'stext item delimiters to {return}
set the clipboard to ListeAdresses as text-- mets le text dans le presse papier
 
tell application "Microsoft Excel" -- cree un nouveau document Excel et colle le texte.
make new document
activate
    tell active sheet to paste
end tell
 
on GetEmail(Tsource) -- extrait la liste des adresses emails contenues dans le texte
    set myList to {}
    set AppleScript'stext item delimiters to "@"
    set Parts to text items of Tsource
    set AppleScript's text item delimiters to {space, linefeed, return, tab, quote, character id 160, "<", ">", "?", "!", ":", ";", "(", ")"}
    repeat with I from 2 to count of Parts
        set end of myList to (text item -1 of item (I - 1) of Parts) & "@" & (text item 1 of item I of Parts)
    end repeat
    return myList
end GetEmail

Peut être que le problème vient de là ? Je ne pense pas...

Comment rendre le script fonctionnel s'il te plaît?

Merci
Pierre

[PBELL]

Bonjour,
Malgré ma relecture, un espace a sauté lors de la copie de 2 lignes de code. Il faut ajouter un espace entre "item" et "I" sur les 2 lignes ci dessous :

Code :

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

1
2
 tell me to set mesAdr to GetEmail(content of item I of maListe) -- récupère les emails dans le corps du texte        
set DestListe to every recipient of item I of maListe-- lit la liste de tous les recipients (incl. to, cc et bcc)

J'ai beau relire à chaque fois, lorsque je passe du mode prévisualisation de réponse à l'envoi définitif, des espaces se perdent !
Ajoute ces espaces et tout devrait fonctionner.

Par ailleurs, heureusement que tu n'arrives pas à copier/coller les N°, ils ne font pas partie du script (Applescript n'a pas de N° d'instruction), mais sont ajoutés par ce site pour l'affichage.

Cordialement

[neuTh]

En effet ça fonctionne avec l'espace merci

Par contre le code généré par Excel ne convient pas du tout mais vraiment.

Voici un exemple de ce que ça me fait :

marine.bouvais@ami-ingredients.fr
image002.jpg@01D55F10.0B6BFE80
image006.png@01D55F10.40BDE580
image005.png@01D55F10.0B6BFE80
image006.png@01D504FA.8DFA1690
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
@font-face
@font-face
@font-face
@page
image001.jpg@01D566EF.451B4690
marine.bouvais@ami-ingredients.fr
marine.bouvais@ami-ingredients.fr
image002.jpg@01D566EF.451B4690
m@4
4@5l
5l@4
4@11
11@9
9@11
11@9
9@5xe
@0
@1
@2
@3
@3
@0
@6
@7
@8
@7
@10
image003.png@01D566EF.451B4690
image004.png@01D566EF.451B4690
image005.jpg@01D566EF.451B4690
image010.jpg@01D5585A.9E08DEA0
Marine.BOUVAIS@ami-ingredients.fr&gt
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
image001.jpg@01D5616A.DA243010
marine.bouvais@ami-ingredients.fr
marine.bouvais@ami-ingredients.fr
image002.jpg@01D5616A.DA243010
image004.png@01D5616C.E6DFB340
image005.jpg@01D5616A.DA243010
image010.jpg@01D5585A.9E08DEA0
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
image001.jpg@01D55F10.0B6BFE80
marine.bouvais@ami-ingredients.fr
marine.bouvais@ami-ingredients.fr
image002.jpg@01D55F10.0B6BFE80
image006.png@01D55F10.40BDE580
image005.png@01D55F10.0B6BFE80
image006.png@01D504FA.8DFA1690
Marine.BOUVAIS@ami-ingredients.fr
Marine.BOUVAIS@ami-ingredients.fr
@import
@media
@media
privacy@mailjet.com
privacy@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
support@mailjet.com
support@mailjet.com
contact@mailjet.com
cvladimirova@mailjet.com
cvladimirova@mailjet.com
support@mailjet.com
support@mailjet.com
contact@mailjet.com
@media
@media
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com&gt
clementchauffage@hotmail.com
clementchauffage@hotmail.com&gt

Je pense que sur Excel je peux trouver une solution pour supprimer les doublons, triplons et voir bien plus...

Mais la liste générée n'est clairement pas propre avec des beugs &gt en fin d'adresse...etc

Qu'en penses-tu s'il te plaît?

Peut être faut il modifier légèrement le script pour éviter les beugs des images et autre chose, pour récupérer que les adresses mails

Merci beaucoup

[PBELL]

Bonsoir,
Je pense que cela vient du code qui extrait des adresses emails: la sous routine GetEmail située en fin de script.

En effet, cette partie de code recherche les @ et prend un "mot" situé avant et un "mot" situé après.
Dans ce cas le "mot" est en fait une suite de caractère depuis le @ et jusqu'à un des caractères de la liste {space, linefeed, return, tab, quote, characterid 160, "<", ">", "?", "!", ":", ";", "(", ")"}
Pour supprimer les résultats qui se finissent par ..hotmail.com&gt, il te suffit d'ajouter le "&" à la liste indiquée ci-dessus.

Par exemple :
corps de texte : "ceci est une ligne avec toto@gmail.com qui est une adresse email"
Ce texte est séparé en 2, de part et d'autre du @ :
partie 1 = "ceci est une ligne avec toto"
partie 2 = "gmail.com qui est une adresse email"

Le dernier "mot" de la partie 1 est "toto" et le premier "mot de la partie 2 est "gmail.com". Ce qui donne bien "toto@gmail.com".
La notion de "mot" est ici la suite de caractères jusqu'à un des caractères de la liste. En l'occurrence, "toto" est la suite de caractère jusqu'à un espace.

Dans ton cas, il faudrait affiner cette partie avec des critères plus précis comme :
- le premier mot de la partie 2 doit être un mot suivit d'un point et de pas plus de 3 lettres avant le prochain espace !
- le premier mot de la partie 1 ne dois pas être vide (visiblement tu as des lignes de corps de texte qui commencent par @font-face.


Je te laisse améliorer cette routine GetEmail de manipulation de texte pour tenir compte de tes cas particuliers. Je pense que tu vois la technique.

Quant à Excel, il existe une fonction standard de suppression des doublons. C'est d'ailleurs un terme impropre car cette fonction supprime les doublons, triplons, quadruplons,... d'un seul clic.
Dans l'onglet Donnée, dans le ruban des fonctions, il y a bouton fait pour ça. Un click et s'est fait. Tu n'as même pas besoin de trier la liste avant !
Donc c'est vraiment très simple.

Cordialement

[neuTh]

Bonsoir
Merci pour tes explications
Je vais rajouter le caractère '&' OK
Pour le reste et donc améliorer le code script, je n'y connais strictement rien

Peut être annuler la recherche du @ dans le corps du mail permettrai de récupérer dans un premier temps toutes les adresses des mails reçus, puis envoyés
Ça enlèverait ces beug de ligne image ou @....

Comment enlever cette fonction dans le code ? Je supprime quelle ligne ?

Sur Excel je vais ensuite supprimer les doublons triplons et plus, pour avoir une liste propre

Merci beaucoup

[PBELL]

Bonjour,

Le premier script supposait que dans le corps de tes emails, il y avait des @ seulement pour les adresses email et que celles-ci était délimitées, avant et après, par des espaces.
Logique, mais apparemment pas suffisant pour le corps de tes emails :
- tu as des @ un peu partout, y compris dans des noms d'image (pratique curieuse)
- tu as des adresses email suivies du signe & sans espace (ce & est interdit dans les noms de domaine et devrait alors servir de séparateur)
- tu as des chiffres séparé par des @

Comme c'est dimanche et que je suis dans un bon jour, j'ai regardé les normes des caractères acceptables pour les adresses emails.
Une adresse valide doit suivre le format aaaa@bbbb.ccc

aaaa est d'une longueur variable, non spécifiée dans la norme. J'ai arbitrairement fixé que cela devait être au moins 4 caractères. Tous les caractères sont possibles, sauf une liste bien définie : espace - normal et insécable, retour, tab, < > ? ! : ; , ( ) @ ç [ ] et %
il faut noter que, selon les sites, le & est autorisé ou interdit. La RFC5322 l'autorise mais compte tenu de tes exemples, je l'ai interdit.

bbbb est le début du nom de domaine et ccc est la fin (par exemple fr ou com,...). j'ai ajouté une vérification d'un point entre bbbb et ccc et le fait que ccc compte 2 ou 3 caractères seulement. Ici aussi j'ai supposé que les domaine principaux des adresses email n'utilisent pas les noms de domaine primaire étendus comme .affrica, .asia, .paris .museum,...

J'ai donc ajouté ces contrôles sur la routine qui extrait les adresses mail du corps du texte de tes emails.
Cela devrait réduire les faux positifs, notamment les "imagexxx@yyyyy.zzzzz , les @font-face, les @3 ou encore les @media !

Voici la routine corrigée. Tu dois la copier et la coller en remplaçant dans le script précédent toutes les lignes entre on GetEmail(Source) et la fin:

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
on GetEmail(Tsource)(* 
extrait la liste des adresses emails contenues dans le texte
    une adresse email est de la forme aaaaa@bbbbb.ccc selon la RFC5322
    aaaaa peut contenir n'importe quel caractère sauf une liste définie (le & est admis ! ). j'ai ajouté qu'il doit contenir plus de 4 caractères
    bbbbb ne doit contenir que des lettres (partie 1 du domaine)
    ccc ne doit contenir que des lettres sur 2 ou 3 caractères (partie 2 du domaine uniquement pour les emails)
*)
    set myList to {}
    set AppleScript'stext item delimiters to "@"
    set Parts to text items of Tsource
    set AppleScript's text item delimiters to {space, linefeed, return, tab, quote, character id 160, "<", ">", "?", "!", ":", ";", "(", ")", "@", "ç", "[", "]", "%", "&"}
    repeat with i from 2 to count of Parts
        set P1 to (text item -1 of item (i - 1) of Parts) -- partie aaaaa
        set P2 to (text item 1 of item i of Parts)
        set P1_OK to (length of P1 > 3) -- partie aaaa compte plus de 4 caractères
        set PosPt to offset of "." in P2
        set P2_OK to (PosPt > 0) and ((((length of P2) - PosPt) = 2) or (((length of P2) - PosPt) = 3)) -- domaine contient un point et 2 ou 3 car après
        if P1_OK and P2_OK then set end of myList to P1 & "@" & P2
    end repeat
    return myList
end GetEmail

Encore une fois, j'ai largement commenté car cette routine pourrait être utile à d'autres.

Cordialement

[neuTh]

Bonjour PBELL

Quel travail, c'est vraiment sympathique de ta part.
Je pense en effet que ça va pouvoir servir à toute la communauté.

C'est très bien vu pour le format aaaa@bbbb.ccc.
Donc seulement les adresses mails qui ont un minimum de 4 lettres avant et après le @, seront prisent en compte.
Si je veux que les extensions de plus de 3 lettres .ccc soient prises en compte, je mets aaaa@bbbb.cccc ( par exemple pour les .shop ou .store qui sont de plus en plus courantes, moi-même j'utilise un .shop )

La liste est clairement beaucoup plus propre, merci.
Voici un aperçu :

o.pitz@royalposthumus.com
sales@royalposthumus.com
//clients.thag.fr/malt/refonte_email_transactionnel_client/images/Icon-Dashboard-inviter1@2x.png
//clients.thag.fr/malt/refonte_email_transactionnel_client/images/Icon-Dashboard-inviter1@3x.png
//mosaic02.ztat.net/vgs/media/pdp-gallery/YO/11/2M/01/0Q/11/YO112M010-Q11@12.jpg
info@royalposthumus.com

Il reste, je pense, un soucis d'images.
Peut être interdire les extensions .png et .jpeg .jpg .pdf .gif ?

Un grand merci à toi, bravo, bon dimanche.
Cordialement,
Pierre.

[PBELL]

Le minimum de 4 caractère s'applique pour l'instant que sur la partie aaaa et pas sur la partie bbbb.

Pour la partie domaine , le ccc, pour le mettre valide de 2 à 4 caractères, il faut changer la ligne :

Code :

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

setP2_OKto (PosPt > 0) and ((((lengthofP2) - PosPt) = 2) or (((lengthofP2) - PosPt) = 3))

Par la ligne :

Code :

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

setP2_OKto (PosPt > 0) and ((((lengthofP2) - PosPt) > 1) and (((lengthofP2) - PosPt) < 5))

Il est aussi possible d'extraire cette partie et de la comparer à une liste de valeur que l'on souhaite (difficile de lister tout) ou à une liste de valeurs que l'on souhaite exclure.
Cependant je pense que cette partie serait plus efficacement traitée avec Excel.

Cordialement

[neuTh]

Je viens de lancer le script sur un dossier de 6000 mails reçus ( toujours le même expéditeur mais 6000 adresses mails différentes dans le corps des mails)
Ça a planté le Mac pendant 1h.
L'application 'Éditeur de script', ne répond pas

Je pense qu'il faut procéder 1000 mails par 1000 mails.
Avec mes 30 000 mails reçus et 30 000 envoyés ( 60 operations mais au final ça devrait fonctionner)

Pour le soucis des extensions jpeg png pdf gif etc
Je laverai le fichier Excel en faisant une recherche et en supprimant les valeurs comprenant celles ci.

Encore merci, tu es d'une aide précieuse
Je vais pouvoir créer ma campagne d'emailing avec MailJet pour le lancement de mon nouveau site Web.

Bravo

[PBELL]

Effectivement, c'est un peu la limite tant de Applescript et des listes.
Applescript est un language d'évènements et donc nécessairement plus lent car il envoie ces requêtes, ici à Outlook, qui à son tour les interprète.
Quant au nombre d'emails et donc d'éléments dans une liste, il a tendance à ralentir en mémoire.

Tu as raison pour rester simple, il est préférable de lancer le script sur des paquets de l'ordre de 1000 emails.
Cela dépend aussi de la puissance de ta machine, de ta version de système et surtout de ta mémoire vive.

Bon courage

[neuTh]

Oui 1000 par 1000 ça fonctionne bien, merci.

Que dois je supprimer dans le script pour que ça ne prenne pas en compte le fait de récupérer les adresses mails dans le corps du mail, s'il te plaît ?

Car pour les 30 000 mails reçus et 30 000 envoyés, je n'ai besoin de récupérer que l'adresse de l'expéditeur pour l'un et destinataire pour l'autre.

Ça permettrait d'éviter les beugs d'images png jpeg etc, qui sont pris en compte concernant notamment les pièces jointes.

Merci beaucoup
Pierre

[PBELL]

Que dois je supprimer dans le script pour que ça ne prenne pas en compte le fait de récupérer les adresses mails dans le corps du mail

Pour faire au plus simple, il faut remplacer la ligne du script principal :

Code :

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

tell me to set mesAdr to GetEmail(content of itemI of maListe)-- récupère les emails dans le corps du texte

...par la ligne :

Code :

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

set mesAdr to {}

Le script se contentera de copier les adresses des destinataires, des cc et ccc.

Cordialement

[neuTh]

Bonjour PBELL

En modifiant cette ligne, dans mon dossier mails reçus :
Ca n'extrait pas les adresses mails des expéditeurs mais du destinataire, donc moi.
Mince...

Il faudrait mettre une ligne qui récupère les mails des expéditeurs.
Pour mon dossier mails envoyés, ce code fonctionne car récupère les destinataires.

Merci à toi
Pierre