EXTRACTION ADRESSE EMAIL

'
'       --------------------------------------------
'       Recherche d'une adresse email dans un string
'       --------------------------------------------
'
        Function EmailSearch(Msg As String) As String
            '
            Dim N As Long       'Index du caractère @
            Dim I As Long       'Index de recherche autour de N
            Dim S As String     'String contenant l'email trouvé ou la chaine vide
            '
            '   Une adresse email contient toujours @
            '
            S = ""              'Init à rien trouvé
            N = InStr(Msg, "@") 'Recherche caractère spécifique adresse email
            '
            '   Si on trouve le caractère @ ...
            '
            If N > 0 Then
                S = "@"
                '
                '   Recherche en amont
                '
                I = 1
                Do While ValCar(Mid(Msg, N - I, 1))
                    S = Mid(Msg, N - I, 1) & S
                    I = I + 1
                Loop
                '
                '   Recherche en aval
                '
                I = 1
                Do While ValCar(Mid(Msg, N + I, 1))
                    S = S & Mid(Msg, N + I, 1)
                    I = I + 1
                Loop
                '
                '   On ne laisse que la fin non traitée du string de départ
                '   pour permettre de rechercher simplement une autre adresse
                '   email dans ce nouveau string
                '
                Msg = Mid(Msg, N + I)
            End If
            '
            '   EmailSearch contient l'adresse email trouvée, ou la chaine vide
            '
            EmailSearch = S
        End Function
'
'       ---------------------------------------------------------------------------
'       Fonction retournant Vrai si le caractère est accepté dans une adresse email
'       ---------------------------------------------------------------------------
'       Le 12/02/07 : Ajout chiffres !
'
        Function ValCar(S As String) As Boolean
            ValCar = (InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_", UCase(S)) > 0)
        End Function

12 février 2007 22:35:09 :

Nelle version avec ajout des chiffres autorisés dans une adresse email. (Merci pour la remarque. Oubli fatal de ma part !) Lorsqu'un email est trouvé, tout le début du texte jusqu'à la fin de l'email est maintenant supprimé, ce qui permet simplement en rappelant ce même programme de chercher une autre adresse email dans le texte restant (si on souhaite conserver le texte original, utiliser une variable string intermédiaire).