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

Clic para descargar Velneo Open source Software - Plataforma para el desarrollo de aplicaciones sobre base de datos

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

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

Otro ejemplo

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 visual basic 6.0

Recursos visual basic.net

Ejemplo del objeto RegEx de .NET para validar un mail

Buscar en Recursos vb