Sección de códigos , trucos y ejemplos para visual basic

95 - Verificar si una dirección de email es válida

Contenido

Ejemplo 1
Ejemplo 2
Enlaces relacionados

Ejemplo 1

Función que permite validar si una dirección de mail es válida.

Para probar la función que valida si una cuenta de correo es correcta o no, colocar un Command1 y un Text1. Luego escribir una dirección de mail y pulsar el Command1, al pulsar el Command se llama a la función ValidarEmail, que retorna un valor Boolean, y muestra un MsgBox

Controles :

un Command1
un text1

Código fuente en el formulario

Option Explicit 'Función que comprueba si una diección de email es válida '********************************************************************************* Public Function Validar_Email(ByVal Email As String) As Boolean Dim i As Integer, iLen As Integer, caracter As String Dim pos As Integer, bp As Boolean, iPos As Integer, iPos2 As Integer On Local Error GoTo Err_Sub Email = Trim$(Email) If Email = vbNullString Then Exit Function End If Email = LCase$(Email) iLen = Len(Email) For i = 1 To iLen caracter = Mid(Email, i, 1) If (Not (caracter Like "[a-z]")) And (Not (caracter Like "[0-9]")) Then If InStr(1, "_-" & "." & "@", caracter) > 0 Then If bp = True Then Exit Function Else bp = True If i = 1 Or i = iLen Then Exit Function End If If caracter = "@" Then If iPos = 0 Then iPos = i Else Exit Function End If End If If caracter = "." Then iPos2 = i End If End If Else Exit Function End If Else bp = False End If Next i If iPos = 0 Or iPos2 = 0 Then Exit Function End If If iPos2 < iPos Then Exit Function End If Validar_Email = True Exit Function Err_Sub: On Local Error Resume Next Validar_Email = False End Function ' botón para validar '''''''''''''''''''''' Private Sub Command1_Click() MsgBox "La dirección de correo : " & Text1 & vbNewLine & _ Format(Validar_Email(Text1), "Yes/No") & " ... es válida ", vbInformation End Sub Private Sub Form_Load() Command1.Caption = "validar E-Mail" Text1 = "Escribir dirección" End Sub

Ejemplo 2

Este otra función, entre otras comprobaciones , permite comprobar si el dominio de la cuenta de correo es correcto, por ejemplo un .com. .net. .gov, inf, etc...

Código fuente de la función :

Option Explicit Public MensajeError As String ' la función retorna TRue o False ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function Validar_Email(ByVal Email As String) As Boolean Dim strTmp As String Dim n As Long Dim sEXT As String MensajeError = "" Validar_Email = True sEXT = Email Do While InStr(1, sEXT, ".") <> 0 sEXT = Right(sEXT, Len(sEXT) - InStr(1, sEXT, ".")) Loop If Email = "" Then Validar_Email = False MensajeError = MensajeError & "No se indicó ninguna dirección de " & _ "mail para verificar!" & vbNewLine ElseIf InStr(1, Email, "@") = 0 Then Validar_Email = False MensajeError = MensajeError & "La dirección de email con contiene el signo @" & vbNewLine ElseIf InStr(1, Email, "@") = 1 Then Validar_Email = False MensajeError = MensajeError & "El @ No puede estar al principio" & vbNewLine ElseIf InStr(1, Email, "@") = Len(Email) Then Validar_Email = False MensajeError = MensajeError & "El @ no puede estar al final de la dirección" & vbNewLine ElseIf EXTisOK(sEXT) = False Then Validar_Email = False MensajeError = MensajeError & "LA dirección no tiene un dominio válido, " MensajeError = MensajeError & "por ejemplo : " MensajeError = MensajeError & ".com, .net, .gov, .org, .edu, .biz, .tv etc.. " & vbNewLine ElseIf Len(Email) < 6 Then Validar_Email = False MensajeError = MensajeError & "La dirección no puede ser menor a 6 caracteres." & vbNewLine End If strTmp = Email Do While InStr(1, strTmp, "@") <> 0 n = 1 strTmp = Right(strTmp, Len(strTmp) - InStr(1, strTmp, "@")) Loop If n > 1 Then Validar_Email = False MensajeError = MensajeError & "Solo puede haber un @ en la dirección de email" & vbNewLine End If Dim pos As Integer pos = InStr(1, Email, "@") If Mid(Email, pos + 1, 1) = "." Then Validar_Email = False MensajeError = MensajeError & "El punto no puede estar seguido del @" & vbNewLine End If If MensajeError <> "" Then MsgBox MensajeError, vbCritical End If End Function Public Function EXTisOK(ByVal sEXT As String) As Boolean Dim EXT As String, X As Long EXTisOK = False If Left(sEXT, 1) <> "." Then sEXT = "." & sEXT sEXT = UCase(sEXT) 'just to avoid errors EXT = EXT & ".COM.EDU.GOV.NET.BIZ.ORG.TV" EXT = EXT & ".AF.AL.DZ.As.AD.AO.AI.AQ.AG.AP.AR.AM.AW.AU.AT.AZ.BS.BH.BD.BB.BY" EXT = EXT & ".BE.BZ.BJ.BM.BT.BO.BA.BW.BV.BR.IO.BN.BG.BF.MM.BI.KH.CM.CA.CV.KY" EXT = EXT & ".CF.TD.CL.CN.CX.CC.CO.KM.CG.CD.CK.CR.CI.HR.CU.CY.CZ.DK.DJ.DM.DO" EXT = EXT & ".TP.EC.EG.SV.GQ.ER.EE.ET.FK.FO.FJ.FI.CS.SU.FR.FX.GF.PF.TF.GA.GM.GE.DE" EXT = EXT & ".GH.GI.GB.GR.GL.GD.GP.GU.GT.GN.GW.GY.HT.HM.HN.HK.HU.IS.IN.ID.IR.IQ" EXT = EXT & ".IE.IL.IT.JM.JP.JO.KZ.KE.KI.KW.KG.LA.LV.LB.LS.LR.LY.LI.LT.LU.MO.MK.MG" EXT = EXT & ".MW.MY.MV.ML.MT.MH.MQ.MR.MU.YT.MX.FM.MD.MC.MN.MS.MA.MZ.NA" EXT = EXT & ".NR.NP.NL.AN.NT.NC.NZ.NI.NE.NG.NU.NF.KP.MP.NO.OM.PK.PW.PA.PG.PY" EXT = EXT & ".PE.PH.PN.PL.PT.PR.QA.RE.RO.RU.RW.GS.SH.KN.LC.PM.ST.VC.SM.SA.SN.SC" EXT = EXT & ".SL.SG.SK.SI.SB.SO.ZA.KR.ES.LK.SD.SR.SJ.SZ.SE.CH.SY.TJ.TW.TZ.TH.TG.TK" EXT = EXT & ".TO.TT.TN.TR.TM.TC.TV.UG.UA.AE.UK.US.UY.UM.UZ.VU.VA.VE.VN.VG.VI" EXT = EXT & ".WF.WS.EH.YE.YU.ZR.ZM.ZW" EXT = UCase(EXT) 'just to avoid errors If InStr(1, EXT, sEXT, 0) <> 0 Then EXTisOK = True End If End Function Private Sub Form_Load() ' verdadero MsgBox "Dirección de email inf@dominio.com:" & _ Validar_Email("inf@dominio.com"), vbInformation ' falso MsgBox "Dirección de email @dominio.com:" & _ Validar_Email("@dominio.com"), vbInformation ' falso MsgBox "Dirección de email @dominio.com:" & _ Validar_Email("asd@com"), vbInformation End Sub

Recursos vb - Enlaces relacionados a Email

Recursos visual basic.net

Ejemplo del objeto RegEx de .NET para validar un mail

Buscar en Recursos vb