macro for validating and highlight email ID wrongly formated.

Can you give examples of what you consider correctly & incorettly formated email ID's

Originally Posted by mudraker

Can you give examples of what you consider correctly & incorettly formated email ID's

 
Sub Emailvalidate()
Dim str As String
Dim i As Integer
Dim pos1 As Integer
Dim pos2 As Integer
Dim diff As Integer


str =active.cell
i = Len(str)
If i <> 0 Then
pos1 = InStr(1, str, "@")
pos2 = InStr(1, str, ".")
If pos1 <> 0 And pos2 <> 0 Then
 
   If pos1 < pos2 Then
    diff = pos2 - pos1
     
     If diff = 1 Then
     MsgBox ".Please enter correct format.", vbError + vbOKOnly, "Error"
     Email_Pattern_1.SetFocus
     Exit Sub
     ElseIf pos2 = i Then
     MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
     Email_Pattern_1.SetFocus
     Exit Sub
     End If
   
   
   If validate(str, i, pos1, pos2) = True Then
   'MsgBox "valid email-id", vbInformation + vbOKOnly, "valid id"
   'Exit Sub
   Else
   MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
   Email_Pattern_1.SetFocus
   Exit Sub
   End If
   
  Else
  MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
  Email_Pattern_1.SetFocus
  Exit Sub
  End If

Else
MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
Email_Pattern_1.SetFocus
Exit Sub
End If
End If
MsgBox "Enter a email-id", vbCritical + vbOKOnly, "emai-id"

End Sub

Private Function validate(str1 As String, ilen As Integer, ipos1 As Integer, ipos2 As Integer) As Boolean
validate = True
Dim fstr1 As String
Dim fstr2 As String
Dim fchr1 As String
Dim fstr3 As String
Dim fstr4 As String

Dim ascii As Integer
Dim ascii1 As Integer
Dim ascii2 As Integer
Dim ascii3 As Integer
Dim ascii4 As Integer




fstr1 = Mid(str1, ipos1 + 1, 1)
fstr2 = Mid(str1, ipos2 + 1, 1)
fchr1 = Mid(str1, 1, 1)
fstr3 = Mid(str1, ipos1 - 1, 1)
fstr4 = Mid(str1, ipos2 - 1, 1)

ascii = Asc(fchr1)
ascii1 = Asc(fstr1)
ascii2 = Asc(fstr2)
ascii3 = Asc(fstr3)
ascii4 = Asc(fstr4)


'check if the first character is '@'
If ipos1 = 1 Then
validate = False
Exit Function
End If

'check if the first character is '.'
If ipos2 = 1 Then
validate = False
Exit Function
End If

'check if the first character is an alphabhet
If Not (ascii >= 65 And ascii <= 122) Then
validate = False
Exit Function
End If

'check the previous character  to the @
If Not (ascii3 >= 48 And ascii3 <= 122) Then
validate = False
Exit Function
End If

'check the previous character  to the .
If Not (ascii4 >= 65 And ascii4 <= 122) Then
validate = False
Exit Function
End If


'check the next character to the @
If Not (ascii1 >= 65 And ascii1 <= 122) Then
validate = False
Exit Function
End If

'check the next character to the .
If Not (ascii2 >= 65 And ascii2 <= 122) Then
validate = False
Exit Function
End If

'check for the two subsequent '@'
If fstr1 = "@" Then
validate = False
Exit Function
End If

'checks for the two subsequent '.'
If fstr2 = "." Then
validate = False
Exit Function
End If


End Function

End Function

Dear Mr.mudraker sir
What i am trying to do is written here above .so please evaluate it and provide me Guidance
to solve my problem.this code is working well in Ms-Access.

Thanks and regrads
Mukesh

In your code you refer to Email_Pattern_1.SetFocus several times.

What is Email_Pattern_1 & how is it setup? I am assuming that as you have used setfocus it is an object on a form.

I can see what appear to be several errors in your code.

You have posted code with 2 End Functions listed when there should only be one.

In Emailvalidate you have a msgbox just before the End Sub. This should be inside an if - else - end if statement

Your validation function is validating some charaters that I beleive it should not be - here are some characters that were being approved
: ; < = > ?.[\]^_`
I have changed the function so that it no longer validates these characters.

When testing a number that is not going to be a negative I suggest you use

instead of using
If i <> 0 Then
use I
If i > 0 Then

I also suggest that instead of setting validate to true at the start of the function and then seeting it to false when it fails set validate to false at the start and only set it to true once it has passed all tests. This is what I have done in the version I have attached.

Attached is the 2 macros modified to give the results you are after
Note :- After modifying the macros I run the macro testing for various errors - It is possible I have overlooked something.

Sub Emailvalidate()
   Dim str As String
   Dim i As Integer
   Dim pos1 As Integer
   Dim pos2 As Integer
   Dim diff As Integer
   
   
   str = ActiveCell
   i = Len(str)
   If i > 0 Then
      pos1 = InStr(1, str, "@")
      pos2 = InStr(1, str, ".")
      If pos1 > 0 And pos2 > 0 Then
         If pos1 < pos2 Then
            diff = pos2 - pos1
            If diff = 1 Then
               MsgBox ".Please enter correct format.", vbError + vbOKOnly, "Error"
              Email_Pattern_1.SetFocus
               Exit Sub
            ElseIf pos2 = i Then
               MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
              Email_Pattern_1.SetFocus
               Exit Sub
            End If
            If validate(str, i, pos1, pos2) = True Then
               'MsgBox "valid email-id", vbInformation + vbOKOnly, "valid id"
               'Exit Sub
            Else
               MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
               Email_Pattern_1.SetFocus
               Exit Sub
            End If
         Else
            MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
            Email_Pattern_1.SetFocus
            Exit Sub
         End If
      Else
         MsgBox "Please enter correct format", vbError + vbOKOnly, "Error"
         Email_Pattern_1.SetFocus
         Exit Sub
      End If
   Else
      MsgBox "Enter a email-id", vbCritical + vbOKOnly, "emai-id"
   End If
End Sub



Private Function validate(str1 As String, ilen As Integer, ipos1 As Integer, ipos2 As Integer) As Boolean
   Dim fstr1 As String
   Dim fstr2 As String
   Dim fchr1 As String
   Dim fstr3 As String
   Dim fstr4 As String

   validate = False
   
   fstr1 = Mid(str1, ipos1 + 1, 1)
   fstr2 = Mid(str1, ipos2 + 1, 1)
   fchr1 = Mid(str1, 1, 1)
   fstr3 = Mid(str1, ipos1 - 1, 1)
   fstr4 = Mid(str1, ipos2 - 1, 1)

   'check if the first character is '@'
   If ipos1 = 1 Then
      Exit Function
   End If

   'check if the first character is '.'
   If ipos2 = 1 Then
      Exit Function
   End If

   'check if the first character is an alphabhet

   Select Case fchr1
   Case "a" To "Z", "A" To "Z"
   
   Case Else
      Exit Function
   End Select

   'check the previous character to the @

   Select Case fstr3
   Case 0 To 9, "a" To "z", "A" To "Z"
  
   Case Else
      Exit Function
   End Select

   'check the previous character to the .
   Select Case fstr4
   Case "a" To "z", "A" To "Z"
 
   Case Else
      Exit Function
   End Select

   'check the next character to the @
   Select Case fstr1
   Case "a" To "z", "A" To "Z"
   
   Case Else
      Exit Function
   End Select

   'check the next character to the .
   Select Case fstr2
   Case "a" To "z", "A" To "Z"
   
   Case Else
      Exit Function
   End Select
   
   'check for the two subsequent '@'
   If fstr1 = "@" Then
      Exit Function
   End If
   
   'checks for the two subsequent '.'
   If fstr2 = "." Then
      Exit Function
   End If

   validate = True
End Function