[behailu]

Function isValidEmail(myEmail As String) As Boolean
' existence of '@'
If occurrenceOf(myEmail, "@") = 0 Then
isValidEmail = False
Exit Function
End If
' existence of '@' more than once.
If occurrenceOf(myEmail, "@") > 1 Then
isValidEmail = False
Exit Function
End If
' existence of '.'(dot).
If occurrenceOf(myEmail, ".") = 0 Then
isValidEmail = False
Exit Function
End If
' existence of space
If occurrenceOf(myEmail, " ") <> 0 Then
isValidEmail = False
Exit Function
End If
' the first char is digit
If Left$(myEmail, 1) Like "[0-9]" Then
isValidEmail = False
Exit Function
End If
' existence of . in the ID part, or x@.x pattern
If (InStr(1, myEmail, "@") + 1) >= InStrRev(myEmail, ".") Then
isValidEmail = False
Exit Function
End If
isValidEmail = True
End Function

Function occurrenceOf(source As String, char As String)
Dim i As Integer, j As Integer
Dim myCount As Integer
myCount = 0
i = InStr(1, source, char)
Do While i > 0
myCount = myCount + 1
i = InStr(i + 1, source, char)
Loop
occurrenceOf = myCount
End Function

This post has been edited by behailu: 06 March 2006 - 07:58 AM

[Amadeus]

Moved to proper forum.

Can you specify what the problem is with the code you've written?

[Aaroniza]

why don't you just do:

Public Sub CorrectEmail(Email)
Dim iscorrect As Boolean
LCase (Email)
If Email Like "*@*.com" Or Email Like "*@*.co.uk" Then
iscorrect = True
Else
iscorrect = False
End If
End Sub

Sorted.

[Amadeus]

That leaves a lot of open areas (for example, that would allow special characters)...to close them in that manner, you'd have to specify a ton of exceptions.

Better to use regular expressions for validation of this sort.

[Nitish4uall]

Hear is Your Email validator..

Public Function checkMailVal(getPreVal As String) As Boolean
'Replace the boolean with string and uncomment as specified below to get
' the error message occured

		'first check for any invalid character
		Dim parseMail
		
		
		For parseMail = 1 To Len(getPreVal)
			
			If (chkAccChars(Mid(getPreVal, parseMail, 1))) + _
			(chkAlfaN(Mid(getPreVal, parseMail, 1))) = 0 Then
			
				'Uncommment next line to return string
				'checkMailVal = "Invalid character in the e-mail"
				
				'Comment this when returning message string
				checkMailVal = False
				Exit Function
			End If
		Next
		
		
		
		' check if @ and . are present in the IDs
		If InStr(1, getPreVal, "@") = 0 Or InStr(1, getPreVal, ".") = 0 Then
			checkMailVal = "The @ and the DOT must be present in the email ID"
			Exit Function
		End If
		
		
		' there should be only one @
		
		Dim atCtr, pos
		atCtr = 0
				
		For pos = 1 To Len(getPreVal)
					
					If Mid(getPreVal, pos, 1) = "@" Then
						'increment the atCtr(ctr which
						'counts the @ in the text
						atCtr = atCtr + 1
					End If
					
					'not more than 1 @ is allowed in the
					'mail address!!
					If atCtr > 1 Then
					
						'Uncommment next line to return string
						'checkMailVal = "Not more than one @ is allowed!"
						
						'Comment this when returning message string
						checkMailVal = False
						
						Exit Function
					End If
		Next
		
		
		' Now capture the position of @ and . for later use
		
		Dim atPosGlobal As Integer
		Dim dotPosGlobal() As Integer
		Dim arrCtr As Integer
		Dim parseCtr As Integer
		
		
		' populate an array with the positions of the @
		For parseCtr = 1 To Len(getPreVal)
			If Mid(getPreVal, parseCtr, 1) = "." Then
				arrCtr = arrCtr + 1
				ReDim Preserve dotPosGlobal(arrCtr)
					
				dotPosGlobal(arrCtr) = parseCtr
			End If
		Next
		
		' get the @ position
		atPosGlobal = InStr(1, getPreVal, "@")
		
		
		
		If (chkAlfaN(Mid(getPreVal, 1, 1))) * _
		(chkAlfaN(Mid(getPreVal, Len(getPreVal), 1))) = 0 Then
				'Uncommment next line to return string
				'checkMailVal = "Invalid character at the start or end of the mail ID"
				
				'Comment this when returning message string
				checkMailVal = False
			   Exit Function
		End If

		If (chkAlfaN(Mid(getPreVal, atPosGlobal - 1, 1))) * _
		(chkAlfaN(Mid(getPreVal, atPosGlobal + 1, 1))) = 0 Then
				'Uncommment next line to return string
				'checkMailVal = "The @ is placed before or after an invalid character"
				'Comment this when returning message string
				checkMailVal = False
			   Exit Function
		End If


		'now ensure that the . doesn't repeat itself in sequence
		' eg> ..(this is wrong) .com(this is right)

		Dim currDotPos, prevDotPos
		For currDotPos = 1 To Len(getPreVal)
			If Mid(getPreVal, currDotPos, 1) = "." Then
				If currDotPos - prevDotPos = 1 Then
					'Uncommment next line to return string
					'checkMailVal = "You cannot have the DOT placed in continuous sequence"
					
					'Comment this when returning message string
					checkMailVal = False
					Exit Function
				Else
					prevDotPos = currDotPos
				End If
			End If
		Next
		
				
		'the @ should lie next to an alphanumeric character
		 
			
			
		
		' Now check for the @ pos
		' the @ should typically lie like this x@x.xx
		' which means the @ should neither lie in the end
		' or the start of the mail id
		
		
				
				
				'the email is structurely right if it has reached so far
				
				' next check if the "." lies within the last 4 chars
							   
				Dim revPos, valParse
				
				For valParse = 1 To Len(getPreVal)
					
					If Mid(getPreVal, Len(getPreVal) - (valParse - 1), 1) = "." Then
						If valParse > 4 Then
							'Uncommment next line to return string
							checkMailVal = "The amount of characters placed after the last DOT is incorrect"
							
							'Comment this when returning message string
							checkMailVal = False
							Exit Function
						End If
						Exit For
					End If
				
				Next
			 
					
				
	
	
	'all is well
	'now return back an empty string
	'checkMailVal = ""
	checkMailVal = True
	
End Function

Private Function chkAlfaN(getChar) As Boolean
	Select Case Asc(getChar)
		Case 97 To 122, 65 To 90, 48 To 57
				'97-122(a-z), 65-90(A-Z)
				'48-59(0-9)
			chkAlfaN = True
		Case Else
			chkAlfaN = False
	End Select
	
	
End Function


Private Function chkAccChars(getChar) As Boolean
	Select Case Asc(getChar)
		Case 45 To 47, 64, 95, 126
				'-./@_~
			chkAccChars = True
		Case Else
			chkAccChars = False
	End Select
	
	
End Function

[born2c0de]

Nitish4uall,
I think you should read the Forum Rules before posting anywhere around the forums.

The Rule is that we don't provide direct solutions to problems to members who haven't attempted the problem themselves.

But in this case, he has. So instead of providing him with a 'new' working function, it's recommended to figure out the errors in his own code and let him know.

That way it'll encourage people to learn rather than just hunt for answers.

To behailu,
I'll make this a bit interesting for you.
As Amadeus pointed out, you can't use "Like" because writing the exceptions would take up a lot of time and CPU cycles.

It would be better if you could use IF..THEN..ELSE Code Constructs and check for constraints.
You've forgotten to add a few constraints and conditions and I'll let you figure them out by this list of email addresses (well not exactly) which are considered legitimate by your function ie. returns True.

Have a look and see if you can proceed. If not, we're always here

• nitish4uall@please_read_rules.com
  
• nitish4uall@nodirectsolutions.
  
• .b2c@thisonetoo.com
  
• ßeta@alpha.net
  
• b2c@dream.in.code.net
  
• wink;-)@dic.net
  
• [tag_me]@dic.net

Just put in those extra conditions and you're done

P.S : I might have forgotten some constraints *half sleepy*