Allow multiple points in an Email form control

[Fleap]

Hello, this is my first post on this forum so I hope I am in the right place
I created an input form including an Email field with restrictions so that there is only one point as well as a single @ to "verify" the authenticity of the email address, however, if a user has a "." in the middle of his address, for example: example.test@test.com, the MsgBox saying that the address is not valid comes out. I cannot find how to allow one or more additional points in the entry ... Thank you in advance for your help
Here's my code :

Private Sub Valider2_Click()

Dim Add As Integer

Add = Sheets("Fichier source contacts").Cells(Rows.Count, 2).End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne libre du tableau

Dim Pointeur
Dim aroTrouv
Dim pointTrouv
Dim Longueur

Pointeur = 1
aroTrouv = 0
pointTrouv = 0
Longueur = Len(Me.ChampMail.Value)


While Pointeur <= Longueur - 2

If Mid(ChampMail, Pointeur, 1) = "@" Then
aroTrouv = aroTrouv + 1
End If

If Mid(ChampMail, Pointeur, 1) = "." Then
pointTrouv = pointTrouv + 1
End If

Pointeur = Pointeur + 1

Wend
If IsNull(ChampMail.Value) Or ChampMail.Value = "" Then
aroTrouv = 1
pointTrouv = 1
End If

If ChampName = "" Then
MsgBox ("Merci de saisir le nom")
Else
If ChampPName = "" Then
MsgBox ("Merci de saisir le prénom")
Else
If aroTrouv <> 1 Or pointTrouv <> 1 Then
MsgBox ("Merci de saisir une adresse mail valide")
Else
Sheets("Fichier source contacts").Cells(Add, 2) = Sheets("Fichiers source client et prosp").Cells(2, 11)
Sheets("Fichier source contacts").Cells(Add, 3) = "A créer"
Sheets("Fichier source contacts").Cells(Add, 4) = ChampName
Sheets("Fichier source contacts").Cells(Add, 5) = ChampPName
Sheets("Fichier source contacts").Cells(Add, 6) = ListeFonction 'ChampFonction
Sheets("Fichier source contacts").Cells(Add, 7) = ChampMail
Sheets("Fichier source contacts").Cells(Add, 8) = ChampTel
Unload Me
MsgBox ("L'interlocuteur a été créé avec succès")
End If
End If
End If

End Sub

 

[RayFrye]

This might help. I would notify the user immediately of an error in he email address.


emailaddress = "test@somewhere.com"

If InStr(emailaddress, "@") = 0 Then
MsgBox "Email missing @ sign"
End
End If

spitEmail = Split(emailaddress, "@")

If InStr(spitEmail(1), ".") = 0 Then
MsgBox "Email missing a period in the Domain name"
End
End If