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