Ai galera, tô necessitando da ajuda de vc's....

 

Estou montando uma agenda que tem os seguintes campos:

   Código = 5 dígitos

   Nome = 30   ||

   Email = 50    ||

 

Meu problema é: quando e digitar o email, pode ser quando perder o foco mesmo, tenha uma função que verifique se o email digitado é válido ou não. Se alguém puder e ajudar agradeço de coração...

 

sds[]´

 

Patrick

Faça assim..

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
PS.: Essa função foi desenvolvida pelo WebMaster do VBWEB

 

e no Evento LostFocus da caixa de texto(esse eh o evento que eh chamado quando uma caixa de texto perde o foco) coloque o seguinte:

 

Private Sub txtMail_LostFocus()

    if txtMail.text = "" then Exit sub 'Para não verificar se for vazio :)
    If isEmail(txtMail.Text) = False Then
        MsgBox "E-Mail inválido!"
        With txtMail
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    End If
End Sub

 

ATENçÂO: Eu não aconselho a colocar para posicionar o focu novamente na caixa.. pois isso farar com que o usuário seja obrigado a digitar um e-mail msm se não for necessário.. a não ser que o usuário nãi digite nada... mais isso fica a seu critério..

aew.. vc mora pertin de mim neh?? VIVA!!

Desculpe parceiro, quando vc colocou o seu codigo acho que enviamos ao mesmo tempo. Ai veio repetido.

Uma dica eu dou: Use essa função no evento VAlidate da txt que assim ela não perdera o foco e não vai haver conflito.

Para saber masi sobre este evento faça uso da busca e digite "Validate"

 

'Não tem erro!

 

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 = "_" Or cValido Like "[0-9]") 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

 

Fuii!

ai galera vou tentar com os códigos enviados por vc's....

 

Valeu mesmo, se precisarem tô na área e se derrubar é pênalti.

 

sds, Patrick