Discussion :

[xonel]

Bonjour,

Au sein de mon service ou je travail, je souhaiterai gérer une boite mail avec une macro, j'ai pas un énorme niveau en VBA mais je pense pouvoir me débrouiller avec une base et l'aide sur la toiles et il y a déjà pas mal d'existant par ci par là, que j'ai d'ailleurs déjà plus au moins repéré...

Dans les grande lignes; j'aimerais gérer la sauvegarde automatique des mails en .msg à chaque nouvelle réception, classer dans des répertoires en local sur le réseau automatiquement.

J'explique ce que je souhaiterais gérer en macro en détail pour mon cas personnel; j'ai une boite mail dans laquelle des mails de mes fournisseurs sont reçu avec des pièces jointes, ou pas. En local sur notre réseau j'ai une répertoire "Fournisseurs" avec dedans un dossier par fournisseur (créé manuellement), dans un premier temps j'aimerais pouvoir détecter lorsqu'un mail arrive dans la boite si fournisseur1@mail.fr alors stocker le .msg dans repertoire Z:\fournisseurs\fournisseur1\exp_sujet_date.msg. Mais voilà j'ai 200 fournisseurs je me vois mal faire le test en dure 200 fois ! je ne sais pas comment optimisé plus que ça... j'ai exporté ma base (excel) fournisseurs en .txt, j'avais pensé alimenté un tableau en VBA de ce .txt (nomfournisseur|mail )et tester si mail expéditeur dans .txt = mail expéditeur reçu alors stocker dans répertoire... quelque chose du genre.

Et dans un deuxième temps, dans tout les mails reçu par mes fournisseurs, il y a obligatoire quelque part dans le mail, soit le Sujet, le corps ou titre pièce jointe PDF, une référence nommé ainsi "ref1234567890", elle peu contenir au minimum 2 digits comme 10, elle peut aussi contenir un espace "ref 1234567890" ou un tiret "ref-1234567890".
Donc en parallèle à cette sauvegarde de .msg par fournisseurs précédemment évoqué, je souhaiterais faire la même mais qu'il me créé automatique un sous-dossier sur la chaîne de caractère trouvé du corps, sujet ou titre pièces-jointes, par exemple s'il me trouve dans un mail reçu la chaine de caractère "ref548793" je veux qu'il créé automatiquement un dosssier sur mon réseau dans mon répertoire "references", Z:\references\ref548793\exp_sujet_date.msg, avec le .msg sauvegardé dedans.

J'ai du mal à visualiser comment coder tout ça, et encore moins comment l'optimiser.

1/Comment gérer mon test de fournisseurs pour exporter les .msg dans leur répertoire...
2/Comment gérer le test sur la chaîne de caractère; si "ref" trouvé alors regarder si suivie de digits qui le précède, si oui alors concaténer tout les digits tant que pas d'espace, et tester si espace ou tiret entre "ref" et les digits...
3/Comment créer un répertoire en macro...
4/Astuces pour optimiser au mieux

j'espère avoir été assez clair et utilisé les bon termes, je vois la logique de ce que je veux faire mais à coder c'est plus compliqué pour moi.

Je souhaite déjà savoir si c'est faisable, et si oui vos conseils et bout de code sont les bienvenue si quelqu'un à déjà fait quelque chose de similaire je suis preneur.
Merci d'avance

[Oliv-]

Salut,

Tu dis je veux "gérer une boite mail avec une macro", donc ce n'est pas TA bal principale !

Quel type de BAL s'agit il ? c'est une BAL partagée ? EXCHANGE, OFFICE365?
Combien de personnes y on accès ?

Pour le déclenchement , tu peux soit utiliser une règle avec l'action "exécuter un script", ou une
une de ces solutions
http://www.slipstick.com/developer/p...s-with-macros/

Tu peux effectivement charger ta liste de fournisseurs dans une variable tableau

Le plus efficace pour trouver une chaine de caractère dans une autre c'est les REGEX, tu peux aussi utiliser instr() ou split()

Pour l'export en .msg, tu peux consulter cette fonction
https://www.developpez.net/forums/bl...le-disque-msg/

[xonel]

Bonsoir, merci de ton retour, effectivement tu as raison, ce n'est pas ma BAL principal (exchange), 5 personnes y on accès pour rechercher ce qu'il souhaite, donc il faudrait pointer dessus au début de la macro (disons que la macro sera installée sur mon poste), le but à terme est de faire la recherche par la suite directement du .msg sur le réseau dans leur répertoire par \fournisseurs, ou par \Ref....

merci pour les liens et les conseils pour les chaines de caractères, je vais y jeter un coup d’œil, cool, donc mon idée de charger mes données d'un .txt est bonne, je ne maîtrise pas encore les tableaux, dans mon .txt si sur une ligne mes données sont séparer de "|" par exemple, est-ce gérable ?

Merci

[Oliv-]

Pourquoi ne pas implmenter cette organisation dans cette BAL directement plutot que sur un réseau ?

est-ce que vos boites sont sur OFFICE 365 ?

[xonel]

Non pas office 365

Non nous voulons vraiment sauvegarder en local, pas sur la BAL Outlook.

j'ai utilisé ce code pour pointer sur la boite souhaité et cela fonctionne :

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
Private Sub Application_Startup()
 
    Dim objNS As Outlook.NameSpace
    Dim objNomBoite As Recipient
    Dim objDossier As Outlook.MAPIFolder
 
    'Outlook 2019 / pour Outlook 2016 utiliser : objSession.GetNamespace("MAPI")
    Set objNS = Application.GetNamespace("MAPI")
        Set objNomBoite = objNS.CreateRecipient("NomBAL")
            Set objDossier = Application.Session.GetSharedDefaultFolder(objNomBoite, olFolderInbox)
        Set m_colInbox = objDossier.Items
    Set objNS = Nothing
    Set objNomBoite = Nothing
    Set objDossier = Nothing
 
End Sub

Puis celui ci pour effectuer l'action à chaque nouveau message reçu :

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
Private Sub m_colInbox_ItemAdd(ByVal Item As Object)
 
    Dim objMsg As Outlook.MailItem
    On Error Resume Next
        If Item.Class = olMail Then
            Set objMsg = Item
 
            ''''''->> Code <<-''''''
 
                Dim mail As MailItem
                Dim savePath As String
                Const olMsg As Long = 3
 
                If TypeName(Item) <> "MailItem" Then Exit Sub
 
                Set mail = Item
 
                savePath = "C:\Users\name\Desktop\Temp\"  'Chemin en dur pour test
                savePath = savePath & mail.SenderEmailAddress & "_" & mail.SenderName & "_" & mail.Subject & "_" & Format(Now(), "yyyy-mm-dd_hh-NN-ss")
                savePath = savePath & ".msg"
 
                Debug.Print savePath
 
                mail.SaveAs savePath, olMsg
        End If
    Set objMsg = Nothing
 
End Sub

Simple test pour exporter en .msg

Jusque là ça fonctionne, maintenant il faut que je fasse évoluer le code...

[xonel]

Bonjour,

j'avance doucement mais surement dans mon code VBA.

Pour chaque pièces jointes présentes dans le mail, j'arrive à récupérer (grâce à une boucle) dans une variable string, le nom des pièces jointes en forçant en majuscule et en supprimant l'extension.

Voici ce que je peux avoir comme cas :
REF123467
REF 123465
REF:1234569
REF : 1345679
REF N°123456
TEXT REF12354 TEXT
REFERENCE13245678
REFERENCE 1324569


Je souhaite formater tout ces types de cas de nom en un seul, standardiser en REF123456, pour ensuite générer un répertoire avec ce nom.

Je ne sais pas gérer les fonctions sur chaines pour autant de cas, limite il faudrait créer une function je pense, j'ai besoin d'être éclairer je ne sais pas dans qu'elle logique commencer.

Merci d'avance.

[Oliv-]

Voici plusieurs approches

tu peux tester à partir d'Excel où EN COLONNE A se trouve tes strings

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
Sub cherche()
 
    For i = 2 To 9
        Mystring = Range("a" & i).Value
        Range("B" & i).Value = fixformat(Mystring)
        Range("C" & i).Value = fixformat2(Mystring)
        Range("D" & i).Value = fixformat3(Mystring)
 
    Next i
End Sub
 
Function fixformat(Mystring)
 
    Dim strString
    strString = Replace(Mystring, "REFERENCE", "REF", , , vbTextCompare)
    strString = Replace(strString, "REF ", "REF", , , vbTextCompare)
    strString = Replace(strString, "REF: ", "REF", , , vbTextCompare)
    strString = Replace(strString, "REF:", "REF", , , vbTextCompare)
    strString = Replace(strString, "REFN°", "REF", , , vbTextCompare)
    fixformat = strString
 
End Function
 
Function fixformat2(Mystring)
    Set obj = CreateObject("vbscript.regexp")
    obj.Global = True
    obj.Pattern = "[a-z,A-Z,_,:,°, ]+"
    chaine = Mystring
    chaine = obj.Replace(chaine, "")
 
    fixformat2 = "REF" & chaine
End Function
Function fixformat3(ByVal s As String) As String
 
    Dim i As Long
    For i = 1 To Len(s)
        If Not IsNumeric(Mid(s, i, 1)) Then Mid(s, i, 1) = "/"
    Next i
 
    s = Replace(s, "/", "")
    fixformat3 = "REF" & s
End Function

[xonel]

Bonjour, merci beaucoup Oliv j'ai testé ça fonctionne fort, le seul hic c'est si ma chaine est "REF N°1234 et REF N°4321" par exemple, et bien il va me retourner REF12344321.

Mes fournisseurs ne sont pas très carrés, je peux recevoir vraiment sous toute les formes, et je peux avoir ce cas dans aussi bien dans un titre de pièces jointes, le sujet du mail, ou pire le corps du mail, donc si je comprends bien, tout ce qui sera numérique derrière sera prit dans la fonction... il faudrait une délimitation, logiquement si ça trouve un espace après du numérique, on stop. Est-ce possible ?

Si il y a deux REF dans un titre de PJ ou Sujet du mail, seulement le premier sera prit en compte, tant pis pour le second, trop difficile à gérer j'imagine, et au pire je peux retrouver sa trace dans mes sauvegardes .msg par fournisseurs. En revanche ou il faut pouvoir délimiter après l'espace dire stop, pour pas qu'il me récupère d'autre numérique, exemple un N° de téléphone...

[Oliv-]

dans ce cas tu fais un SPLIT sur le string

Code :

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

1
2
3
4
5
6
7
8
Sub test()
toto = Split("REF N°1234 et REF N°4321", "REF", , vbTextCompare)
 
For i = 0 To UBound(toto)
MsgBox toto(i)
 
Next i
End Sub

[xonel]

Finalement ce que je veux faire est un peu plus complexe, prenons l'exemple dans un corps de mail: "Je vous transmet la reférence : refA: 12354-78, cordialement"

Je souhaite récupérer "refA: 1234-78" pour le transformer en REFA1234-78.

J'ai nommé ref1 car finalement je peux avoir deux type de ref, voir trois, refA, refB et refC, donc finalement pas en dur dans le code, peut aussi être nommé référence A, référence B, référence C.

Comment faire pour repérer le début "refA" ou "référence A", repérer la fin par l'espace ou la virgule pour l'exemple, et repérer tout ce qui peut séparer comme :, espace, : espace, espace : espace, sans espace etc...

Je sais que refA, refB, référence A etc... peuvent être suivi de ces séparateurs: "", " ", ":", " :", " : ", "-", comment repérer le début "refA" ou "référence A" etc..., puis la fin qui est en numérique, peut contenir un tiret, mais sans tomber sur un numéro de tel qui traine dans le corps du message par exemple...

Et petit subtilité, je veux garder le tiret dans mes numériques, car j'ai un cas d'un fournisseur ou il y a un tiret (20-5489), c'est pour ça que je l'ai mis en exemple.

Je suis certain que c'est faisable mais je bloque sur la logique du codage et manque d'expérience sur les fonctions des strings... est-ce que REGEX est capable ?

[Oliv-]

le plus puissant et efficace ce sont les regex

MAIS C4EST AUSSI assez complexe tu as un exemple dans l'une des fonctions d'hier

il faut que tu cherches sur internet vba "vbscript.regexp"

[xonel]

Merci, je vais m'y pencher sérieusement, ça à l'air puissant RegEx, car j'avais commencé à faire des tests avec du Instr, lens, rights, left, mid, etc... puis des boucles for... mais ça devenait imbuvable niveau code et j'avance à rien j'arrive pas à ce que je veux vu le nombre de chose à tester et à trouver.

[xonel]

Bonsoir,

J'ai mis de côté le Regex pour l'instant même si je suis certain que c'est faisable... j'ai réussi avec l'aide d'un collègue à faire quelque chose, un peu lourd mais qui fonctionne, avec du remplissage de tableaux et du Instr, Len, Mid, et boucle For... voir code ci-dessous...

J'ai un petit soucis, dans mon string si j'ai qu'une référence ça trouve sans problème, mais si j'en ai deux, exemple "Bonjour, je vous transmet le code article REF:33333333, avec la référence:55555555" il va aller me chercher seulement la première occurrence, normal, je ne sais pas trop comment gérer ça pour qu'il balaye tout, une boucle Do While ?

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
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
Sub test_recherche()
    Dim TabType(20) As String
    Dim TabCarac(20) As String
    Dim TabFin(20) As String
    Dim tab_resf(20) As String
    Dim Debut As Integer
    Dim Fin As Integer
    Dim TestSortieFor As Boolean
    Dim i, j, k, m As Integer
    Dim ChercheType As String
    Dim NumTrouve As String
 
    'Initialisation
    Debut = 0
    Debut = 0
    Fin = 0
    MaChaine = LCase("Bonjour, je vous transmet le code article REF:33333333, avec la référence:55555555") 'force la majuscule
 
    'Chargement des tableaux
    TabType(0) = 3:     TabType(1) = "ref"
                        TabType(2) = "référence"
                        TabType(3) = "reference"
 
 
    'Tableau caractère à trouver entre début et fin
    TabCarac(0) = 9:    TabCarac(1) = "-"
                        TabCarac(2) = "_"
                        TabCarac(3) = " "
                        TabCarac(4) = "."
                        TabCarac(5) = ":"
                        TabCarac(6) = " :"
                        TabCarac(7) = ": "
                        TabCarac(8) = " : "
                        TabCarac(9) = ""
 
    'Tableau fin à trouver possible
    TabFin(0) = 3:  TabFin(1) = "."
                    TabFin(2) = " "
                    TabFin(3) = ","
 
    'Tableau resf
    tab_resf(0) = 0
 
 
    TestSortieFor = False
        For i = 1 To CInt(TabType(0))
            For j = 1 To CInt(TabCarac(0))
                If InStr(1, MaChaine, TabType(i) & TabCarac(j)) > 0 Then
                    Debut = InStr(1, MaChaine, TabType(i) & TabCarac(j)) + Len(TabType(i)) + Len(TabCarac(j))
                    ChercheType = TabType(i)
                    For k = 1 To CInt(TabFin(0))
                        If InStr(Debut, MaChaine, TabFin(k)) > 0 Then
                        tab_resf(0) = tab_resf(0) + 1: tab_resf(tab_resf(0)) = InStr(Debut, MaChaine, TabFin(k)) - 1
                    End If
                    Next k
                If tab_resf(0) = 0 Then
                Fin = Len(MaChaine)
                Else
                Fin = tab_resf(1)
                For m = 1 To tab_resf(0)
                If tab_resf(m) < Fin Then Fin = tab_resf(m)
                    Next m
                End If
 
                NumTrouve = (Mid(MaChaine, Debut, Fin - Debut + 1))
 
                MsgBox NumTrouve
 
                TestSortieFor = True: Exit For
                End If
            Next j
            If TestSortieFor = True Then TestSortieFor = False: Exit For
        Next i
 
End Sub

Au passage, si quelqu'un serait le faire en Regex je suis preneur Merci

[Oliv-]

en utilisant split