ola tudo bom peço a ajuda a vc, como que eu faço para fazer uma verificarçao na caixa de texto se não tem a simbolo @ ou se foi digitado www ?

 

entendendo melhor

eu tenho que fazer uma verificaçao se foi colocado no email @ e se a pessoa colocou o www no email que nao pode...

 

entendeu o que quis dizer!

 

obrigado

Esnir

Estagiario da area de informatica

Public Function isEmail(ByVal pEmail As String) As Boolean

Dim Conta As Integer, Flag As Integer, cValido As String

isEmail = False

If Len(pEmail) < 5 Then
Exit Function
End If

'Verifica se existe caracter inválido

For Conta = 1 To Len(pEmail)
cValido = Mid(pEmail, Conta, 1)
If Not (LCase(cValido) Like "[a-z]" Or cValido = _
"@" Or cValido = "." Or cValido = "-" Or _
cValido = "_") Then
Exit Function
End If
Next

'Verifica a existência de (@)

If InStr(pEmail, "@") = 0 Then
Exit Function
Else
Flag = 0

For Conta = 1 To Len(pEmail)
If Mid(pEmail, Conta, 1) = "@" Then
Flag = Flag + 1
End If
Next

If Flag > 1 Then Exit Function
End If

If Left(pEmail, 1) = "@" Then
Exit Function
ElseIf Right(pEmail, 1) = "@" Then
Exit Function
ElseIf InStr(pEmail, ".@") > 0 Then
Exit Function
ElseIf InStr(pEmail, "@.") > 0 Then
Exit Function
End If

'Verifica a existência de (.)

If InStr(pEmail, ".") = 0 Then
Exit Function
ElseIf Left(pEmail, 1) = "." Then
Exit Function
ElseIf Right(pEmail, 1) = "." Then
Exit Function
ElseIf InStr(pEmail, "..") > 0 Then
Exit Function
End If

isEmail = True

End Function

Se entendi direito o que você quer seria validar email :

Se for faça isto:

Function ValidEmail(ByVal strCheck As String) As Boolean
Const sInvalidChars As String = "!#$%^&*()=+{}[]|;:'/?>,< "

Dim bCK As Boolean
Dim strDomainType As String
Dim strDomainName As String
Dim i As Integer

bCK = Not InStr(1, strCheck, Chr(34)) > 0 'Check to see if there is a double quote
If Not bCK Then GoTo ExitFunction

bCK = Not InStr(1, strCheck, "..") > 0 'Check to see if there are consecutive dots
If Not bCK Then GoTo ExitFunction

If Len(strCheck) > Len(sInvalidChars) Then
    For i = 1 To Len(sInvalidChars)
        If InStr(strCheck, Mid(sInvalidChars, i, 1)) > 0 Then
            bCK = False
            GoTo ExitFunction
        End If
    Next
Else
    For i = 1 To Len(strCheck)
        If InStr(sInvalidChars, Mid(strCheck, i, 1)) > 0 Then
            bCK = False
            GoTo ExitFunction
        End If
    Next
End If

If InStr(1, strCheck, "@") > 1 Then 'Check for an @ symbol
    bCK = Len(Left(strCheck, InStr(1, strCheck, "@") - 1)) > 0
Else
    bCK = False
End If
If Not bCK Then GoTo ExitFunction

strCheck = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "@"))
bCK = Not InStr(1, strCheck, "@") > 0 'Check to see if there are too many @'s
If Not bCK Then GoTo ExitFunction

strDomainType = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "."))
bCK = Len(strDomainType) > 0 And InStr(1, strCheck, ".") < Len(strCheck)
If Not bCK Then GoTo ExitFunction

strCheck = Left(strCheck, Len(strCheck) - Len(strDomainType) - 1)
Do Until InStr(1, strCheck, ".") <= 1
    If Len(strCheck) >= InStr(1, strCheck, ".") Then
        strCheck = Left(strCheck, Len(strCheck) - (InStr(1, strCheck, ".") - 1))
    Else
        bCK = False
        GoTo ExitFunction
    End If
Loop
If strCheck = "." Or Len(strCheck) = 0 Then bCK = False

ExitFunction:
ValidEmail = bCK
End Function

 

Também tem esta outra função :

Confira esta dica de uma função para realizar a verificação do e-mail, se o mesmo é valido. Confira abaixo a função:

Private Function ValidEMail(sEMail As String) As Boolean
    Dim nCharacter As Integer
    Dim Count As Integer
    Dim sLetra As String

'Verifica se o e-mail tem no MÍNIMO 5 caracteres (a@b.c)
    If Len(sEMail) < 5 Then
        'O e-mail é inválido, pois tem menos de 5 caracteres
        ValidEMail = False
        MsgBox "O e-mail digitado tem menos de 5 caracterec!!!"
        Exit Function
    End If

'Verificar a existencia de arrobas (@) no e-mail
    For nCharacter = 1 To Len(sEMail)
        If Mid(sEMail, nCharacter, 1) = "@" Then
            'OPA!!! Achou uma arroba!!!
            'Soma 1 ao contador
            Count = Count + 1
       End If
    Next
'Verifica o número de arrobas.
'TEM que ter """UMA""" arroba

    If Count <> 1 Then
        'O e-mail é inválido, pois tem 0 ou mais de 1 arroba
        ValidEMail = False
        MsgBox "O nº de arrobas (@) do e-mail é inválido!!!"
        Exit Function
    Else
        'O e-mail tem 1 arroba.
        'Verificar a posição da arroba

        If InStr(sEMail, "@") = 1 Then
            'O e-mail é inválido, pois começa com uma @
            ValidEMail = False
            MsgBox "O e-mail foi iniciado com uma arroba (@)!!!"
            Exit Function

        ElseIf InStr(sEMail, "@") = Len(sEMail) Then
            'O e-mail é inválido, pois termina com uma @
            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
            'OPA!!! Achou um ponto!!!
            'Soma 1 ao contador
            Count = Count + 1
        End If
   Next
    'Verifica o número de pontos.
    'TEM que ter PELO MENOS UM ponto.

    If Count < 1 Then
        'O e-mail é inválido, pois não tem pontos.
        ValidEMail = False
        MsgBox "O e-mail é inválido, pois não contém pontos (.)!!!"
        Exit Function
    Else
        'O e-mail tem pelo menos 1 ponto.
        'Verificar a posição do ponto:

    If InStr(sEMail, ".") = 1 Then
        'O e-mail é inválido, pois começa com um ponto
        ValidEMail = False
        MsgBox "O e-mail foi iniciado com um ponto (.)!!!"
        Exit Function

    ElseIf InStr(sEMail, ".") = Len(sEMail) Then
            'O e-mail é inválido, pois termina com um ponto.
            ValidEMail = False
            MsgBox "O e-mail termina com um ponto (.)!!!"
            Exit Function

    ElseIf InStr(InStr(sEMail, "@"), sEMail, ".") = 0 Then
        'O e-mail é inválido, pois termina com um ponto.
        ValidEMail = False
        MsgBox "O e-mail não tem nenhum ponto (.) após a arroba (@)!!!"
        Exit Function
  End If
End If
nCharacter = 0
Count = 0
'Verifica se o e-mail não tem pontos
'consecutivos (..) após a arroba (@).

If InStr(sEMail, "..") > InStr(sEMail, "@") Then
    'O e-mail é inválido, tem pontos consecutivos após o @.
    ValidEMail = False
    MsgBox "O e-mail contém pontos consecutivos (..) após o arroba (@)!!!"
    Exit Function
End If

'Verifica se o e-mail tem caracteres invá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
        'O e-mail é inválido, pois tem caracteres inválidos
        ValidEMail = False
        MsgBox "Foi digitado um caracter inválido no e-mail!!!"
        Exit Function
    End If
Next
    nCharacter = 0
    'Bem, se a verificação chegou até aqui é porque o e-mail é válido, então...
    ValidEMail = True

End Function

       Adicione um TextBox e CommandButton no formulário, codifique o evento Click do botão conforme a listagem abaixo:

Private Sub Command1_Click()
  Dim VALID As Boolean
  VALID = ValidEMail(Text1.Text)
  If VALID = True Then
    MsgBox "Tudo Ok na verificação!!!"
  Else
    MsgBox "Houve algum problema na verificação!!!"
  End If
End Sub
True Then
    MsgBox "Tudo Ok na verificação!!!"
  Else
    MsgBox "Houve algum problema na verificação!!!"
  End If
End Sub