'Validar e-mails digitados
Public Function ValidEMail(sEMail As String) As Boolean
Dim nCharacter As Integer
Dim Count As Integer
Dim sLetra As String
'Verifique que el correo electrónico tenga al menos 5 caracteres (a@b.c)
If Len(sEMail) < 5 Then
'El correo electrónico no es válido ya que tiene menos de 5 caracteres
ValidEMail = False
MsgBox "El correo electrónico que ingresó tiene menos de 5 caracteres."
Exit Function
End If
'Verificar a existencia de arrobas (@) sin correo electrónico
For nCharacter = 1 To Len(sEMail)
If Mid(sEMail, nCharacter, 1) = "@" Then
'¡Uy! ¡¡¡Encontré una arroba!!!
'Añadir 1 al contador
Count = Count + 1
End If
Next
'Verifica o número de arrobas.
'DEBE tener """UNO""" arroba
If Count <> 1 Then
'El correo electrónico no es válido ya que tiene 0 o más de 1 al
ValidEMail = False
MsgBox "El número de '@' en el correo electrónico no es válido."
Exit Function
Else
'El correo electrónico tiene 1 en.
'Comprobar la posición del signo de arroba
If InStr(sEMail, "@") = 1 Then
'El correo electrónico no es válido ya que comienza con @
ValidEMail = False
MsgBox "El correo electrónico comenzaba con un signo de arroba '@'."
Exit Function
ElseIf InStr(sEMail, "@") = Len(sEMail) Then
'El correo electrónico no es válido ya que termina en @
ValidEMail = False
MsgBox "O e-mail termina com uma arroba '@'."
Exit Function
End If
End If
nCharacter = 0
Count = 0
'Verificar a existencia de pontos (.) no e-mail
For nCharacter = 1 To Len(sEMail)
If Mid(sEMail, nCharacter, 1) = "." Then
'¡¡¡OP!!! ¡¡¡Encontré un punto!!!
'Añadir 1 al contador
Count = Count + 1
End If
Next
'Consulta el número de puntos.
'DEBE TENER AL MENOS UN PUNTO.
If Count < 1 Then
'El correo electrónico no es válido ya que no tiene puntos..
ValidEMail = False
MsgBox "El correo electrónico no es válido ya que no contiene puntos '.'."
Exit Function
Else
'El correo electrónico tiene al menos 1 punto.
'Posición del punto de control:
If InStr(sEMail, ".") = 1 Then
'El correo electrónico no es válido ya que comienza con un punto
ValidEMail = False
MsgBox "El correo electrónico comenzaba con un punto '.'."
Exit Function
ElseIf InStr(sEMail, ".") = Len(sEMail) Then
'El correo electrónico no es válido ya que termina con un punto.
ValidEMail = False
MsgBox "El correo electrónico termina con un punto '.'."
Exit Function
ElseIf InStr(InStr(sEMail, "@"), sEMail, ".") = 0 Then
'El correo electrónico no es válido ya que termina con un punto.
ValidEMail = False
MsgBox "El correo electrónico no tiene punto '.' después del signo de arroba '@'."
Exit Function
End If
End If
nCharacter = 0
Count = 0
'Comprueba que el correo electrónico no tenga puntos consecutivos (..) después del signo de arroba (@).
If InStr(sEMail, "..") > InStr(sEMail, "@") Then
'El correo electrónico no es válido, tiene puntos consecutivos después del @.
ValidEMail = False
MsgBox "El correo electrónico contiene puntos consecutivos '..' después del signo de arroba '@'."
Exit Function
End If
'Comprueba si el correo electrónico tiene caracteres no válidos
For nCharacter = 1 To Len(sEMail)
sLetra = Mid$(sEMail, nCharacter, 1)
If Not (LCase(sLetra) Like "[a-z]" Or sLetra = "@" Or sLetra = "." Or sLetra = "-" Or sLetra = "_" Or IsNumeric(sLetra)) Then
'El correo electrónico no es válido porque tiene caracteres no válidos
ValidEMail = False
MsgBox "Se ingresó un carácter no válido en el correo electrónico."
Exit Function
End If
Next
nCharacter = 0
'Bueno, si la verificación llegó tan lejos, es porque el correo electrónico es válido, así que...
ValidEMail = True
End Function
---------------------------------------------------------------------------------------------
en el campo Me.txtemal_2 tiene que llevar dos a mas emails, por el codigo de validacion solo me reconoce un emal entonces cree otro campo txtemail_3, en el codigo lo agrege asi:
pero solo se envían los dos campos anteriores menos el txtemail_3, alguien sabrá cual seria la sintaxis correcta del código de como enviar dos .CC, .CC o la mejor forma de como enviar dos o más emails en un campo de texto?