Discussion :

[bsangoku]

Bonjour,

Je souhaite créer des balises spécifiques aux adresses mails (ou du moins un format email). Je souhaite savoir si il existe au préalable un format sous Access.

Merci d'avance

[zoom61]

Salut,

A ma connaissance, il n'existe pas de format, mais du moment que tu saisis un texte de la forme aaa@aaa.fr, il le considère comme un email... à toi de vérifier par la suite que le format et bon.

@+.

[jimbolion]

Bonjour,

J'avais à l'époque récupéré cette fonction ! Tu passes en argument ton adresse et en retour tu récupères une valeur true ou False !

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
76
77
78
79
80
 
 
Public Function ValideAdresseEmail(ByVal AdresseMail As String) As Boolean
 
    ' Renvoie True si l'adresse fournie répond aux règles de validitié des emails
 
    ' Chaque caractère de la partie à gauche du @ peut-être composée comme ceci :
    '   Caractères autorisés : de 'a' à 'z', de '0' à '9', le souligné, le point et le tiret
    ' Deux parties pour la zone droite :
    ' - Celle à gauche du dernier point :
    '   Caractères autorisés : de 'a' à 'z', de '0' à '9', le point et le tiret
    '   Au moins 2 caractères
    ' - Celle après le dernier point :
    '   Caractères autorisés : de 'a' à 'z'
    '   2 ou 3 caractères
 
    Dim aComposant() As String
    Dim sPattern     As String
    Dim r            As Long
    Dim t            As Long
    Dim bAnnule      As Boolean
 
    ' Convertit en minuscules et supprime les espaces devant et derrière
    AdresseMail = Trim(LCase(AdresseMail))
    ' Il faut que @ existe dans la chaine
    r = InStr(1, AdresseMail, "@")
    If r > 0 Then
        ' Mais il ne doit y en avoir qu'un seul
        r = InStr(r + 1, AdresseMail, "@") ' Recherche s'il y en a un après
        If r = 0 Then
            ' Ensuite, on va comparer la partie gauche du @
            aComposant = Split(AdresseMail, "@")
            ' Il faut bien sûr qu'il y ait au moins un caractère devant le @
            If Len(aComposant(0)) > 0 Then
                ' On recrée une chaine de comparaison avec autant de comparaison que de caractères
                sPattern = ""
                For r = 1 To Len(aComposant(0))
                    sPattern = sPattern & "[a-z0-9_.-]"
                Next r
                If aComposant(0) Like sPattern Then
                    ' Partie gauche Ok, on va traitrer la partie à droite du @
                    ' Récupère un tableau de chaine située à droite du @ dont le séparateur est le point
                    aComposant = Split(aComposant(1), ".")
                    ' Il faut qu'on ait au moins deux zones (0 et 1 au minimum)
                    If UBound(aComposant) >= 1 Then
                        ' Traite la partie droite du dernier point
                        If aComposant(UBound(aComposant)) Like "[a-z][a-z]" Or _
                           aComposant(UBound(aComposant)) Like "[a-z][a-z][a-z]" Then
                            ' Ok, 2 ou 3 caractères alphabétiques
                            ' Traite les autres zones devant le dernier point
                            bAnnule = False
                            For t = 0 To (UBound(aComposant) - 1)
                                If Len(aComposant(t)) < 2 Then
                                    ' Problème : longueur incorrecte
                                    bAnnule = True
                                Else
                                    sPattern = ""
                                    For r = 1 To Len(aComposant(t))
                                        sPattern = sPattern & "[a-z0-9-]"
                                    Next r
                                    If Not aComposant(t) Like sPattern Then
                                        ' Problème : caractères non autorisés
                                        bAnnule = True
                                        Exit For
                                    End If
                                End If
                                If bAnnule Then Exit For
                            Next t
                            If Not bAnnule Then
                                ' Voilà, c'est tout bon
                                ValideAdresseEmail = True
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
 
End Function

Si cela peut t'aider !

Personnellement je ne l'ai jamais validé mais les tests que j'ai pu faire me semblaient cohérents !

JimboLion