Validación Correo Electronico

un sencillo algoritmo para que en el campo de texto solo se pueda poner algo@algo.com

CODIGO:

Private Sub b_validar_Click()


'Proceso de validacion de correo electrónico

Dim correcta As Boolean

Dim posarroba As Integer 'va a almacenar la posicion

' de la primera @ dentro de la

'dirección, si existe

Dim pospunto As Integer 'va a almacenar la posicion

' del punto despues de la

'primera @, si existe
correcta = True
'comprobaciones de la direccion
'''''''''''''''''''''''''''''''''''''''''''''''''
' COMPROBACIONES 1
'''''''''''''''''''''''''''''''''''''''''''''''''

posarroba = InStr(correo.Text, "@")

If posarroba <= 1 Or posarroba = Len(correo.Text) Then
'no hay ninguna arroba
      correcta = False
Else
      ' hay alguna arroba. ¿hay alguna mas?

      If InStr(posarroba + 1, correo.Text, "@") <> 0 Then
          ' hay una segunda @
         correcta = False
     End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
' FIN DE COMPROBACIONES 1
'''''''''''''''''''''''''''''''''''''''''''''''''
' COMPROBACIONES 2
'''''''''''''''''''''''''''''''''''''''''''''''''
pospunto = InStr(posarroba + 1, correo.Text, ".")
If pospunto = posarroba + 1 Or pospunto = 0 Then
   ' que está pegado a la @ o que no hay ningun punto despues de la @
   correcta = False
End If

If pospunto = Len(correo.Text) Then
   ' La dirección acaba en un .
    correcta = False
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
'fin de las comprobaciones
'''''''''''''''''''''''''''''''''''''''''''''''''
If correcta Then
   MsgBox "La dirección es correcta"
Else
  MsgBox "La dirección no es correcta"
End If
End Sub