Discussion :

[popo68]

Bonjour !

Quelqu'un a une idée de comment faire pour vérifier que l'adresse email saisie est une adresse email valide ?

Existe-t-il une fonction ?

[popo68]

J'avais déjà vu ici le problème en PHP, existe-t-il une équivalence en vba ?

[cafeine]

Hello,

utilise mon tuto sur les Expressions régulières :
http://cafeine.developpez.com/access/tutoriel/regexp/

[popo68]

Sympa le tuto ^^


Donc si je comprent bien, ca donnerait ca :

\w (classe[a-zA-Z0-9]
\B est compris dans le mot
\. caractère "."

Donc si je note \w@\B\w\.\w c'est cohérent ?

ERf non je viens de me rendre compte que si j'ai une adresse dupont.duponD@paul.fr ca ne marche pas a cause du . dans le nom ...

Hmmm
c'est un peu compliqué le tuto, je vais essayé de bien capté le truc

[popo68]

Sinon avant que tu ne post caféine, j'avais tenté ca :

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
Private Sub cmd_send_Click()
On Error GoTo err
 
Dim i As Integer
Dim oEmail As Outlook.MailItem
Dim OLk As Outlook.Application
Dim wAt As Integer, wNom As String, wPt As Integer, wDom As String, wExt As String, wAdresse As String
 
wAt = 0
wPt = 0
 
'créer un nouvel item mail
Set OLk = New Outlook.Application
Set oEmail = OLk.CreateItem(olMailItem)
 
'Vérifie la présence d'un @
wAt = InStr(1, Me.tx_adresse, "@", vbTextCompare)
If wAt = 0 Then
    MsgBox "L'adresse saisie n'est pas une adresse Email valide ! ", vbExclamation, "Attention ! "
    Exit Sub
End If
 
wPt = InStr(wAt, Me.tx_adresse, ".", vbTextCompare)
If wPt = 0 Then
    MsgBox "L'adresse saisie n'est pas une adresse Email valide ! ", vbExclamation, "Attention ! "
    Exit Sub
End If
 
 
wNom = CStr(Left(Me.tx_adresse, wAt - 1))
wDom = CStr(Mid(Me.tx_adresse, wAt + 1, (wPt - wAt - 1)))
wExt = CStr(Right(Me.tx_adresse, (Len(Me.tx_adresse) - wPt)))
 
wAdresse = wNom & "@" & wDom & "." & wExt
 
'définir les paramètres
oEmail.To = CStr(wAdresse)
oEmail.Subject = CStr(Me.tx_objet)
oEmail.Body = CStr(Me.tx_texte)
 
oEmail.Send
 
Set oEmail = Nothing
Set appoutlook = Nothing
 
DoCmd.Close
 
fin:
    Exit Sub
err:
    MsgBox err.Number & " : " & err.Description
 
End Sub

[Tofalu]

Moi j'aurais un pattern de ce style, mais bon je suis un boulet en regexp

"^\w(\w|[-_\.])*@(\w|[-_]){1,}\.\w{1,3}$"

[popo68]

Ah oui là tout de suite je comprends mieux ! lol

Bon je vais étudier ca demain matin, la tête fraiche

Merci en tout cas ^^

[superviny]

je ne sais plus où... mais au gré de mes recherches, je suis tombé sur un code vba pour tester les adresse emails... je l'ai quelques peut modifié à ma sauce...
Il est assez simple... après avoir checké la synthaxe de l'adresse email... il lance la commande "nslookup" sous dos pour tester l'existance ou non d'un record MX.
Vous constaterez également qu'il y a des noms de domain qu'elle accepte par défaut... la liste est non exhaustive... étant belge... j'y ai mis des noms de domaine belge hypra connu... à vous de modifier a votre goût ces noms de domaine... le but de la manoeuvre étant d'augmenter la rapidité de la fonction...

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
 
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0
 
Private Type SECURITY_ATTRIBUTES
    nLength                 As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type
 
Private Type STARTUPINFO
    cb                  As Long
    lpReserved          As Long
    lpDesktop           As Long
    lpTitle             As Long
    dwX                 As Long
    dwY                 As Long
    dwXSize             As Long
    dwYSize             As Long
    dwXCountChars       As Long
    dwYCountChars       As Long
    dwFillAttribute     As Long
    dwFlags             As Long
    wShowWindow         As Integer
    cbReserved2         As Integer
    lpReserved2         As Long
    hStdInput           As Long
    hStdOutput          As Long
    hStdError           As Long
End Type
 
Private Type PROCESS_INFORMATION
    hProcess            As Long
    hThread             As Long
    dwProcessId         As Long
    dwThreadID          As Long
End Type
 
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
 
Public Function ShellEx(ByVal PathName As String, Optional ByVal WinStyle As VbAppWinStyle = vbHide) As String
Dim proc            As PROCESS_INFORMATION
Dim sa              As SECURITY_ATTRIBUTES
Dim start           As STARTUPINFO
Dim sBuffer         As String * 256
Dim hReadPipe       As Long
Dim hWritePipe      As Long
Dim ret             As Long
Dim lngBytesRead    As Long
 
    sa.nLength = Len(sa)
    sa.bInheritHandle = True
    ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
    If (ret = 0) Then
        ShellEx = "##ERROR##"
        Exit Function
    End If
 
    start.cb = Len(start)
    start.wShowWindow = WinStyle
    start.hStdError = hWritePipe
    start.hStdOutput = hWritePipe
    start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    ret = CreateProcessA(0, PathName, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    If (ret = 0) Then
        ShellEx = "##ERROR##"
        Exit Function
    End If
    CloseHandle hWritePipe
 
    Do
        ret = ReadFile(hReadPipe, sBuffer, Len(sBuffer), lngBytesRead, 0&)
        ShellEx = ShellEx & Left$(sBuffer, lngBytesRead)
    Loop While ret
 
    CloseHandle proc.hProcess
    CloseHandle proc.hThread
    CloseHandle hReadPipe
End Function
 
Public Function isEmailValid(emailAddress) As Integer
'RENVOIT -1 si email valide
'        0 si domaine inconnu
'        1 synthaxe incorrecte
'        2 si erreur du processus
 
Const carAccepted As String = "abcdefghijklmnopqrstuvwxyz1234567890éè.@-_"
Dim domainName As String
Dim resultDns As String
Dim retry As Byte
Dim dotInDomainName As Byte
Dim arobaseInDomainName As Byte
Dim lenEmailAddress As Byte
Dim lenDomainName As Byte
 
    If Trim(Nz(emailAddress, vbNullString)) <> vbNullString Then
        arobaseInDomainName = InStr(1, emailAddress, "@")
        If arobaseInDomainName <= 1 Then
            isEmailValid = 1
        Else
            If InStr(1, emailAddress, "..") > 0 Or _
               InStr(1, emailAddress, "@@") > 0 _
            Then
                isEmailValid = 1
                Exit Function
            End If
 
            lenEmailAddress = Len(emailAddress)
 
            If arobaseInDomainName = lenEmailAddress Then
                isEmailValid = 1
                Exit Function
            End If
 
            domainName = Mid(emailAddress, arobaseInDomainName + 1)
 
            dotInDomainName = InStrRev(domainName, ".")
 
            lenDomainName = Len(domainName)
 
            If dotInDomainName > 1 And _
               (dotInDomainName = (lenDomainName - 2) Or dotInDomainName = (lenDomainName - 3) Or dotInDomainName = (lenDomainName - 4)) _
            Then
                For i = 1 To lenEmailAddress
                    If InStr(1, carAccepted, Mid(emailAddress, i, 1)) = 0 Then
                        isEmailValid = 1
                        Exit Function
                    End If
                Next
 
                Select Case domainName
                    Case "skynet.be", "hotmail.com", "telenet.be", _
                         "pandora.be", "scarlet.be", "belgacom.net", _
                         "gmail.com", "yahoo.com", "yahoo.fr", _
                         "swing.be", "tiscali.be", "msn.com", _
                         "versateladsl.be", "advalvas.be", "planetinternet.be", _
                         "brutele.be", "tele2allin.be", "chello.be", _
                         "wanadoo.fr", "tele2.be", "euphonynet.be":
 
                            isEmailValid = -1
 
                    Case Else:
                        retry = 0
                        Do
                            retry = retry + 1
                            resultDns = ShellEx("nslookup -type=MX -retry=3 -timeout=5 " & domainName)
                        Loop While resultDns = "##ERROR##" And retry <= 3
 
                        If resultDns = "##ERROR##" Then
                            isEmailValid = 2
                        Else
                            If InStr(1, Nz(resultDns, vbNullString), "MX preference") = 0 Then
                                isEmailValid = 0
                            Else
                                isEmailValid = -1
                            End If
                        End If
                End Select
            Else
                isEmailValid = 1
            End If
        End If
    Else
        isEmailValid = 1
    End If
 
End Function

[naphta]

Bonjour,

superviny bravo bonne trouvaille ta fonction est une merveille !!
j'adopte de suite

Merci beaucoup

[DMboup]

En partant du fait qu'une adresse mail est un tableau de caractère, je crois qu'on peut faire simple avec peu de moyen.

L'idée est de parcourir la chaine est d'en déduire trois sous chaines
1 - du début jusqu'au signe @
2 - du signe jusqu'au .
3 - du . jusqu'à la fin

Ensuite on regarde si les sous chaine ne contiennent que les caractères autorisés (que l'on peut énumérée dans un tableau aussi).

[superviny]

D'accord avec toi "DMboup", c'est en effet plus simple ... (c'est d'ailleurs ce que fait ma fonction avant même de vérifier si le records MX existe...) mais dans le cas que tu exposes il n'y a pas de vérification sur l'existance ou non du nom de domaine (record mx dont je viens de parler)... et donc la vérification est moins précise...

[Lou Pitchoun]

Salut DMboup,

Il faudrait plutôt faire l'inverse : partir de "l'extension" (.fr, .com...) récupérer la partie entre l'@ et dernier point et ensuite le nom du destinataire.

Pourquoi ?
Simplement parce qu'au boulot j'ai une @ prenom.nom@maboite.mongroupe.fr

En partant du fait qu'une adresse mail est un tableau de caractère, je crois qu'on peut faire simple avec peu de moyen.

L'idée est de parcourir la chaine est d'en déduire trois sous chaines
1 - du début jusqu'au signe @
2 - du signe jusqu'au .
3 - du . jusqu'à la fin

Ensuite on regarde si les sous chaine ne contiennent que les caractères autorisés (que l'on peut énumérée dans un tableau aussi).

[stigma]

Si ça peut t'aider, je te mets mon code brut de pomme :

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 Txt_Mail_AfterUpdate()
 
    '-----------------------  Vérifier la validité de l'e-mail
    If Len(Txt_Mail) > 1 Then
        Dim j As Byte, ok As Boolean
        For j = 1 To Len(Txt_Mail)
            '-------------  pas d'accent
            If Mid(Txt_Mail, j, 1) = "é" Or Mid(Txt_Mail, j, 1) = "è" Or Mid(Txt_Mail, j, 1) = "ë" Or Mid(Txt_Mail, j, 1) = "ï" Then
                MsgBox "Vous avez déjà vu une adresse mail avec des accents ???", vbCritical, "N'IMPORTE QUOI"
                Txt_Mail = Null
                Txt_Mail.SetFocus
                Exit Sub
            End If
            If Mid(Txt_Mail, j, 1) = "@" Then ok = True
        Next
 
        If ok = False Then
            MsgBox "Il Manque le @ !", vbCritical, "ADRESSE INVALIDE"
            Txt_Mail = Null
            Txt_Mail.SetFocus
        End If
    End If
 
    Txt_Mail = LCase(Txt_Mail)
 
    If bl_Modif_Testeur = True Then Call Sauvegarde("Testeur_Mail", Txt_Mail)
 
End Sub

[DMboup]

Salut DMboup,

Il faudrait plutôt faire l'inverse : partir de "l'extension" (.fr, .com...) récupérer la partie entre l'@ et dernier point et ensuite le nom du destinataire.

Oui.

Mais on a peut être pas besoin de changer l'ordre. il fallait juste dire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
2 - du signe (@) jusqu'au dernier point (.)

Pour

If Mid(Txt_Mail, j, 1) = "é" Or Mid(Txt_Mail, j, 1) = "è" Or Mid ...

il vaut mieux avoir un tableau des caractères non autorisés pour les tests.

[superviny]

Voici une variante de mon code en utilisant la bibiothèque Microsoft VBScript Regular Expressions ...

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0
 
Private Type SECURITY_ATTRIBUTES
    nLength                 As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type
 
Private Type STARTUPINFO
    cb                  As Long
    lpReserved          As Long
    lpDesktop           As Long
    lpTitle             As Long
    dwX                 As Long
    dwY                 As Long
    dwXSize             As Long
    dwYSize             As Long
    dwXCountChars       As Long
    dwYCountChars       As Long
    dwFillAttribute     As Long
    dwFlags             As Long
    wShowWindow         As Integer
    cbReserved2         As Integer
    lpReserved2         As Long
    hStdInput           As Long
    hStdOutput          As Long
    hStdError           As Long
End Type
 
Private Type PROCESS_INFORMATION
    hProcess            As Long
    hThread             As Long
    dwProcessId         As Long
    dwThreadID          As Long
End Type
 
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
 
Public Function ShellEx(ByVal PathName As String, Optional ByVal WinStyle As VbAppWinStyle = vbHide) As String
Dim proc            As PROCESS_INFORMATION
Dim sa              As SECURITY_ATTRIBUTES
Dim start           As STARTUPINFO
Dim sBuffer         As String * 256
Dim hReadPipe       As Long
Dim hWritePipe      As Long
Dim ret             As Long
Dim lngBytesRead    As Long
 
    sa.nLength = Len(sa)
    sa.bInheritHandle = True
    ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
    If (ret = 0) Then
        ShellEx = "##ERROR##"
        Exit Function
    End If
 
    start.cb = Len(start)
    start.wShowWindow = WinStyle
    start.hStdError = hWritePipe
    start.hStdOutput = hWritePipe
    start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    ret = CreateProcessA(0, PathName, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    If (ret = 0) Then
        ShellEx = "##ERROR##"
        Exit Function
    End If
    CloseHandle hWritePipe
 
    Do
        ret = ReadFile(hReadPipe, sBuffer, Len(sBuffer), lngBytesRead, 0&)
        ShellEx = ShellEx & Left$(sBuffer, lngBytesRead)
    Loop While ret
 
    CloseHandle proc.hProcess
    CloseHandle proc.hThread
    CloseHandle hReadPipe
End Function
 
 
Public Function isEmailValid2(emailAddress) As Integer
'RENVOIT -1 si email valide
'        0 si domaine inconnu
'        1 synthaxe incorrecte
'        2 si erreur du processus
 
Dim reg As VBScript_RegExp_55.RegExp
Dim domainName As String
 
Set reg = New VBScript_RegExp_55.RegExp
reg.Multiline = False
reg.Pattern = "^([a-zA-Z0-9_\-\.éè]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})$"
If Not reg.test(Nz(emailAddress, vbNullString)) Then
    isEmailValid2 = 1
    Set reg = Nothing
    Exit Function
End If
Set reg = Nothing
 
domainName = Mid(emailAddress, InStr(1, emailAddress, "@") + 1)
 
Select Case domainName
    Case "skynet.be", "hotmail.com", "telenet.be", _
         "pandora.be", "scarlet.be", "belgacom.net", _
         "gmail.com", "yahoo.com", "yahoo.fr", _
         "swing.be", "tiscali.be", "msn.com", _
         "versateladsl.be", "advalvas.be", "planetinternet.be", _
         "brutele.be", "tele2allin.be", "chello.be", _
         "wanadoo.fr", "tele2.be", "euphonynet.be":
 
                isEmailValid2 = -1
 
    Case Else:
        retry = 0
        Do
            retry = retry + 1
            resultDns = ShellEx("nslookup -type=MX -retry=3 -timeout=5 " & domainName)
        Loop While resultDns = "##ERROR##" And retry <= 3
 
        If resultDns = "##ERROR##" Then
            isEmailValid2 = 2
        Else
            If InStr(1, Nz(resultDns, vbNullString), "MX preference") = 0 Then
                isEmailValid2 = 0
            Else
                isEmailValid2 = -1
            End If
        End If
End Select
 
End Function

[DMboup]

Bien que ne l'ayant pas tester, le crois que la solution de superviny fonctionne.

J'ai juste dit qu'on peut avoir quelques chose de très simple avec peu de moyen (surtout que je ne suis pas un as des api).

Par contre il me semble qu'il peut y avoir un problème ici

Select Case domainName
Case "skynet.be", "hotmail.com", "telenet.be", _
"pandora.be", "scarlet.be", "belgacom.net", _
"gmail.com", "yahoo.com", "yahoo.fr", _
"swing.be", "tiscali.be", "msn.com", _
"versateladsl.be", "advalvas.be", "planetinternet.be", _
"brutele.be", "tele2allin.be", "chello.be", _
"wanadoo.fr", "tele2.be", "euphonynet.be":
...

apparamment on est obligé de lister tous les domaines existant. Est ce possible?

[superviny]

Salut DMboup,

En fait mes fonctions elles font un truc tout bête...
Sur ton pc lance une fenetre dos et sur l'invite de commande tu tapes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
nslookup -type=MX -retry=3 -timeout=5 [un nom de domain celui que tu veux]

tu verras que chaques fois qu'un record mx est relié à un nom de domaine dans la fenetre dos apparait: "MX preference = ..."

Donc les api windows tout ce qu'elles font c'est la même chose que la commande Shell en access mais en plus elles récupèrent les informations affichées durant l'éxécution c-à-d ce que tu vois apparaitre dans la fenetre dos...

Il ne me reste qu'a faire un simple instr(...) pour voir si dans ce que j'ai récupéré j'ai un "MX preference = ..." si oui... le nom de domaine est valide ...

Enfin, pour répondre à ta question: "apparamment on est obligé de lister tous les domaines existant. Est ce possible? "

Comme je le disais dans un post plus haut... ce "select case" n'est là que pour augmenter la rapiditer de la fonction... Genre si tu l'utilises la fonction dans une requête... elle va s'exécuter autant de fois que de records bien sûr... L'opération la plus lente dans toute la fonction étant l'éxécution du nslookup... J'ai voulu éviter au maximum de lancer la commande sur des noms de domaine hypra connu... comme par exemple gmail.com, hotmail.com, ... donc le "select case" en gros dit s'il s'agit d'un domaine hypra connu pas la peine d'intérroger le dns avec le commande nslookup... sinon lancer nslookup... tu peux bien sûr adapter à ta convenance cette liste...

J'espère avoir été claire...

[FlorianOuv]

Je ne sais pas si ca va être utile et si c'est correcte mais voici un petit boud de code...

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
 
Function fnVerifMail(strAdresse As String) As Boolean
    ' *** V1.0 - OF - Vérification de l@ mail si conforme
 
    Dim intValCara As Integer
    Dim strCara As String, strCaraSpe As String
    Dim intBloc As Integer      ' --- Servira a savoir dans quel bloc on se place ex : toto@titi.com et donc toto=2 titi=1 et com=0
 
    fnVerifMail = False
 
    ' --- Initialisation pour le 1er bloc
    intBloc = 0
    strCaraSpe = "!#$%&'*+-/=?^_`.{|}~ã"     ' --- Caractères utilisable en plus dans le bloc 2
    If Len(strAdresse) < 8 Then Exit Function
    If InStr(1, strAdresse, "@") = 0 Or InStr(1, strAdresse, ".") = 0 Then Exit Function
 
    For i = Len(strAdresse) To 1 Step -1
        strCara = Mid(LCase(strAdresse), i, 1)
        intValCara = Asc(strCara)
        If intBloc = 0 Then
            ' --- Dans cette partie on utilise que des caractères alphabetiques
            If strCara = "." Then
                intBloc = 1
            ElseIf (intValCara < 97 Or intValCara > 122) Then
                Exit Function
            End If
        ElseIf intBloc = 1 Then
            ' --- Il peut y avoir des caractères plus complexe
            If strCara = "@" Then
                intBloc = 2
            ElseIf (intValCara < 48 Or intValCara > 57) And (intValCara < 97 Or intValCara > 122) And (intValCara < 128 Or intValCara > 165) And (intValCara < 208 Or intValCara > 216) And (intValCara < 224 Or intValCara > 237) And strCara <> "-" And strCara <> "." And strCara <> "_" Then
                Exit Function
            End If
        Else
            ' --- plus de caractères encore
            If (intValCara < 48 Or intValCara > 57) And (intValCara < 97 Or intValCara > 122) And (intValCara < 128 Or intValCara > 165) And (intValCara < 208 Or intValCara > 216) And (intValCara < 224 Or intValCara > 237) And InStr(1, strCaraSpe, strCara) = 0 Then
                Exit Function
            End If
        End If
    Next
    fnVerifMail = True
End Function

[Carmiel]

Bonjour,
je ranime cette discussion si quelqu'un a une réponse.
Je n'ai pas cette réponse au nslookup
Et forcément ça marche pas et en plus ça ramène la même réponse

Avez-vous une idée sur ce qu'il faut récupérer

Si Domaine connu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
C:\Users\Test>nslookup -type=MX -retry=3 -timeout=5 hotmail.fr
Serveur :   ns1.numericable.net
Address:  89.2.0.1

numericable.fr
        primary name server = ns1.tech.numericable.fr
        responsible mail addr = hostmaster.numericable.fr
        serial  = 2016061500
        refresh = 43200 (12 hours)
        retry   = 21600 (6 hours)
        expire  = 3542400 (41 days)
        default TTL = 300 (5 mins)

Je me réponds pour le cas où ça intéresserait quelqu'un d'autre,
SFR/Numericable masque les serveurs DNS, il faut interroger les DNS Google (par exemple), la syntaxe devient donc

resultDns = ShellEx("nslookup -domain=google-public-dns-a.google.com -type=MX -retry=3 -timeout=5 " & domainName)