Tester la validité d'un email

[oguruma]

Code : Tout sélectionner

Sub Initialize
   Dim r As Variant
   Dim sEmail As String
   sEmail={"trucmuche@theworld.com"}   
   r=Evaluate({@ValidateInternetAddress([ADDRESS821];} & sEmail & {)})
   If Trim$(r(0))="" Then
      Msgbox "Adr Email OK"
   Else
      Msgbox r(0)
   End If   
End Sub

[oguruma]

autre version ou complément

Code : Tout sélectionner

Sub Initialize
   Dim r As Variant
   Dim sEmail As String
   Dim sEmailToCheck As String
   sEmailToCheck="trucmuche@theworld.com"
   sEmail={"} & sEmailToCheck & {"}   
   
   r=Evaluate({@ValidateInternetAddress([ADDRESS821];} & sEmail & {)})
   If Trim$(r(0))="" Then
      Msgbox "Adr Email OK"
   Else
      Msgbox r(0)
   End If   
   
   sEmailToCheck="trucémuche@theworld.com"
   sEmail={"} & sEmailToCheck & {"}   
   
   r=Evaluate({@ValidateInternetAddress([ADDRESS821];} & sEmail & {)})
   If Trim$(r(0))="" Then
      Msgbox "Adr Email OK"
   Else
      Msgbox r(0)
   End If   
End Sub

[Michael DELIQUE]

salut

une autre version

Code : Tout sélectionner

Public Function ValidateInternetAddress_LS (Address As String) As Integer
   
'   cet fonction détermine si l'adresse passé en paramêtre est une adresse internet valide
   
   'Déclaration des Variables   
   Dim Like1 As String
   Dim Like2 As String
   Dim Like3 As String
   Dim Like4 As String
   Dim nmName As NotesName
   
   On Error Goto ErreurValidateInternetAddress_LS
   
   Like1 =  "*[!a-z,!A-Z,!0-9,!@,!.,!_,-]*"    'liste des caracteres autorise
   Like2 = "*@*@*"                                  'evite le double @
   Like3 = "*?@?*.??"                 'l'adresse doit contnier au mois 2 caracteres avant et apres le @ et 3 caracteres apres le point
   Like4 = "*?@?*.???"                          'l'adresse doit contnier au mois 2 caracteres avant et apres le @ et 2 caracteres apres le point
   
   'Teste si une adresse est passe en parametre
   If Trim(Address) = "" Then
      ValidateInternetAddress_LS  = False
      Exit Function
   End If
   
   'test si l'adresse possede un format ADR821 :   xxxxx@xxxxx.xxx
   Set nmName = New NotesName(Address)
   If Trim(nmName.Addr821) = "" Then
      ValidateInternetAddress_LS  = False
      Exit Function
   End If
   
   'Teste les caracteres autorises
   If nmName.Addr821 Like Like1 Then
      ValidateInternetAddress_LS  = False
      Exit Function
   End If
   
   'Teste s'il y a plus d'une fois le @
   If nmName.Addr821 Like Like2 Then
      ValidateInternetAddress_LS  = False
      Exit Function
   End If
   
   'test si formatage
   If nmName.Addr821 Like Like3 Then
      ValidateInternetAddress_LS  = True
   Else
      If nmName.Addr821 Like Like4 Then
         ValidateInternetAddress_LS  = True
      Else
         ValidateInternetAddress_LS = False
         Exit Function
      End If
   End If
   
   Exit Function