Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    Gérer la sauvegarde de mails en .msg dans répertoires en local
    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

  2. #2
    Expert éminent
    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/

  3. #3
    Candidat au Club
    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

  4. #4
    Expert éminent
    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 ?

  5. #5
    Candidat au Club
    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...

  6. #6
    Candidat au Club
    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.

  7. #7
    Expert éminent
    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

  8. #8
    Candidat au Club
    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...

  9. #9
    Expert éminent
    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

  10. #10
    Candidat au Club
    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 ?

  11. #11
    Expert éminent
    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"

  12. #12
    Candidat au Club
    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.

  13. #13
    Candidat au Club
    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

  14. #14

###raw>template_hook.ano_emploi###