pana_ir
30 de Abril del 2004

Hola, necesitoq eu alguine me pase el codigo de alguna funci贸n potente que valide direcciones de correo electr贸nico
Muchas gracias y disculpen la rudeza de mi mensaje pero estoy en un aprieto

luckyta
30 de Abril del 2004

HOLA, YO me encontr茅 esta, espero te sirva:

Function FGCorreoValido(correo As String) As Boolean

'funcion que verifica si un texto es un correo electr贸nico v谩lido
FGCorreoValido = True

Dim arroba As Boolean
Dim Punto As Boolean
Dim letradespuesarroba As Boolean

Dim i As Long

Dim j As Long

'si tiene la longitud minima: [email protected]
If Len(correo) >= 6 Then

'recorro el correo de atr谩s a adelante

'compruebo que el 煤ltimo caracter de un correo sea una letra,
'y despues que haya un punto en las pr贸ximas 3 posiciones
For i = 0 To 3

'si es un punto, despues de dos letra al menos, se sale del bucle,
'y guarda la siguiente posicion al punto
If i > 1 And Mid$(correo, Len(correo) - i, 1) = "." Then
Punto = True
j = Len(correo) - i - 1
i = 3

'si no es una letra se sale del bucle
ElseIf Not esLetra(Mid$(correo, Len(correo) - i, 1)) Then

FGCorreoValido = False
i = 3

End If

Next i

If Not Punto Then
FGCorreoValido = False

'compruebo que antes del punto hay, al menos, una letra o un nº
ElseIf Not esLetra(Mid$(correo, j, 1)) And Not IsNumeric(Mid$(correo, j, 1)) Then
FGCorreoValido = False

End If

'si no ha fallado en lo anterior, sigue
If FGCorreoValido Then

'si es una direccion .xxx y la longitud del correo es menor a 7, se sale
If Len(correo) - j + 1 = 5 And Len(correo) >= 7 Or Len(correo) - j + 1 = 4 Then

i = j - 1

While i > 1

'compruebo que s贸lo hay una @ antes del punto, y que no sea la primera letra
If Mid$(correo, i, 1) = "@" And i > 1 Then
If arroba Then
FGCorreoValido = False
Else
arroba = True

'antes y despues de la arroba no puede haber puntos
If Not LetraAntesYDespues(correo, i) Then
FGCorreoValido = False
End If
End If

ElseIf Not esLetra(Mid$(correo, i, 1)) And Not IsNumeric(Mid$(correo, i, 1)) And _
Not Mid$(correo, i, 1) = "_" And Not Mid$(correo, i, 1) = "." Then

FGCorreoValido = False

ElseIf Mid$(correo, i, 1) = "." And Not LetraAntesYDespues(correo, i) Then
FGCorreoValido = False
End If

'sale del bucle
If Not FGCorreoValido Then
i = 1
End If

i = i - 1

Wend

'compruebo que el primer caracter del correo es una letra
If Not esLetra(Mid$(correo, 1, 1)) Then
FGCorreoValido = False
End If

Else
FGCorreoValido = False

End If

End If

'Si el correo no contiene una arroba y un punto despues de la arroba, no es v谩lido
If Not arroba Then
FGCorreoValido = False
End If

Else
FGCorreoValido = False

End If

End Function

Susi
30 de Abril del 2004

Gracias por la funcion,,,desde Peru