Extraction adresse email

Commenter

Contenu du snippet

Routine en VB6 permettant de retrouver une adresse Email dans un texte (le contenu d'un Email par exemple).

Source / Exemple : 


'
'       --------------------------------------------
'       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

Conclusion :


Le sous-programme renvoie la première adresse trouvée. A la charge du programme appelant de rappeler ce sous-programme pour éventuellement en trouver d'autres.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.