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