1. #1
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2006
    Messages
    148
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2006
    Messages : 148
    Points : 112
    Points
    112

    Par défaut Vérifier adresse email en vba ?

    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 ?

  2. #2
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2006
    Messages
    148
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2006
    Messages : 148
    Points : 112
    Points
    112

    Par défaut

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

  3. #3
    Expert éminent
    Avatar de cafeine
    Inscrit en
    juin 2002
    Messages
    3 896
    Détails du profil
    Informations forums :
    Inscription : juin 2002
    Messages : 3 896
    Points : 6 648
    Points
    6 648

    Par défaut

    Hello,

    utilise mon tuto sur les Expressions régulières :
    http://cafeine.developpez.com/access/tutoriel/regexp/
    Ne mettez pas "Problème" dans vos titres, par définition derrière toute question se cache un problème
    12 tutoriels Access



  4. #4
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2006
    Messages
    148
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2006
    Messages : 148
    Points : 112
    Points
    112

    Par défaut


    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

  5. #5
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2006
    Messages
    148
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2006
    Messages : 148
    Points : 112
    Points
    112

    Par défaut

    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

  6. #6
    Rédacteur

    Avatar de Tofalu
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    octobre 2004
    Messages
    9 501
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 34
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Associations - ONG

    Informations forums :
    Inscription : octobre 2004
    Messages : 9 501
    Points : 32 171
    Points
    32 171

    Par défaut

    Moi j'aurais un pattern de ce style, mais bon je suis un boulet en regexp
    "^\w(\w|[-_\.])*@(\w|[-_]){1,}\.\w{1,3}$"

  7. #7
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2006
    Messages
    148
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2006
    Messages : 148
    Points : 112
    Points
    112

    Par défaut



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

  8. #8
    Membre du Club
    Profil pro
    Inscrit en
    mai 2006
    Messages
    48
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : mai 2006
    Messages : 48
    Points : 48
    Points
    48

    Par défaut Ma modeste contribution... pour une fois... lol ;-)

    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

  9. #9
    Membre éclairé

    Homme Profil pro
    Inscrit en
    juillet 2005
    Messages
    626
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Bouches du Rhône (Provence Alpes Côte d'Azur)

    Informations forums :
    Inscription : juillet 2005
    Messages : 626
    Points : 712
    Points
    712

    Par défaut ALors là

    Bonjour,

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

    Merci beaucoup

  10. #10
    Membre expérimenté

    Profil pro
    Inscrit en
    juin 2003
    Messages
    1 223
    Détails du profil
    Informations personnelles :
    Localisation : Sénégal

    Informations forums :
    Inscription : juin 2003
    Messages : 1 223
    Points : 1 545
    Points
    1 545

    Par défaut

    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).
    Amicalement

  11. #11
    Membre du Club
    Profil pro
    Inscrit en
    mai 2006
    Messages
    48
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : mai 2006
    Messages : 48
    Points : 48
    Points
    48

    Par défaut en réponse à DMboup

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

  12. #12
    Rédacteur
    Avatar de Lou Pitchoun
    Profil pro
    Inscrit en
    février 2005
    Messages
    5 016
    Détails du profil
    Informations personnelles :
    Âge : 39
    Localisation : France, Bouches du Rhône (Provence Alpes Côte d'Azur)

    Informations forums :
    Inscription : février 2005
    Messages : 5 016
    Points : 8 213
    Points
    8 213

    Par défaut

    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


    Citation Envoyé par DMboup Voir le message
    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).

  13. #13
    Membre éprouvé Avatar de stigma
    Homme Profil pro
    Développeur en retraite
    Inscrit en
    octobre 2003
    Messages
    961
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : Développeur en retraite
    Secteur : Industrie

    Informations forums :
    Inscription : octobre 2003
    Messages : 961
    Points : 1 239
    Points
    1 239

    Par défaut

    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
    Développement Myst-Like Cutish

  14. #14
    Membre expérimenté

    Profil pro
    Inscrit en
    juin 2003
    Messages
    1 223
    Détails du profil
    Informations personnelles :
    Localisation : Sénégal

    Informations forums :
    Inscription : juin 2003
    Messages : 1 223
    Points : 1 545
    Points
    1 545

    Par défaut

    Citation Envoyé par Lou Pitchoun Voir le message
    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.
    Amicalement

  15. #15
    Membre du Club
    Profil pro
    Inscrit en
    mai 2006
    Messages
    48
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : mai 2006
    Messages : 48
    Points : 48
    Points
    48

    Par défaut petite variante avec Microsoft VBScript Regular Expressions

    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

  16. #16
    Membre expérimenté

    Profil pro
    Inscrit en
    juin 2003
    Messages
    1 223
    Détails du profil
    Informations personnelles :
    Localisation : Sénégal

    Informations forums :
    Inscription : juin 2003
    Messages : 1 223
    Points : 1 545
    Points
    1 545

    Par défaut

    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?
    Amicalement

  17. #17
    Membre du Club
    Profil pro
    Inscrit en
    mai 2006
    Messages
    48
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : mai 2006
    Messages : 48
    Points : 48
    Points
    48

    Par défaut réponse à DMboup

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

  18. #18
    Candidat au Club
    Profil pro
    Inscrit en
    juin 2012
    Messages
    2
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juin 2012
    Messages : 2
    Points : 3
    Points
    3

    Par défaut Petite contribution

    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

  19. #19
    Membre du Club
    Inscrit en
    mars 2008
    Messages
    157
    Détails du profil
    Informations forums :
    Inscription : mars 2008
    Messages : 157
    Points : 66
    Points
    66

    Par défaut

    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)

Discussions similaires

  1. [A-07] Comment recuperer Adresse Email en VBA
    Par NguyenRD dans le forum VBA Access
    Réponses: 2
    Dernier message: 19/12/2008, 15h02
  2. [Mail] Vérifier des adresses email
    Par calitom dans le forum Fonctions
    Réponses: 6
    Dernier message: 02/06/2008, 15h32
  3. Vérifier une adresse email
    Par zulkifli dans le forum Regex
    Réponses: 7
    Dernier message: 03/05/2007, 11h47
  4. Vérifier la validité d'une adresse email
    Par Tourix dans le forum Langage
    Réponses: 9
    Dernier message: 09/10/2006, 17h56
  5. [debutant][ereg] Vérifier une adresse email
    Par romuluslepunk dans le forum java.util
    Réponses: 5
    Dernier message: 05/05/2006, 18h17

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo