codegeeks

Imports System.Text.RegularExpressions
 
Public Class Form1
 
    Private Sub btnExtract_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExtract.Click
 
        Dim textstring As Array
        Dim strEmail As String
        Dim strEmailChars As String
        Dim StrOutPut As String = ""
 
        strEmail = txtMailContent.Text
        StrOutPut = txtResult.Text
        strEmailChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_@."
        For cnt As Long = 0 To strEmail.Length - 1  'Loop throug each charecters in the content
 
            'Check whether the charecter is anything other than valid email charecters (Charecters in the strins "strEmailChars")
            If strEmailChars.Contains(strEmail(cnt)) = False Then
                strEmail = strEmail.Replace(strEmail(cnt), " ") 'Replace that String with space
            End If
        Next
 
        textstring = Split(strEmail) ' no delimeter means use space
 
        Dim emailpattern As String = "^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"
 
        Dim i As Integer
        Dim r As New Regex(emailpattern, RegexOptions.IgnoreCase + RegexOptions.Multiline)
 
        For i = 0 To textstring.GetLength(0) - 1
            Dim m As Match = r.Match(textstring(i))
 
            While m.Success
                If StrOutPut.Contains(m.ToString) = False Then
                    If StrOutPut.Length > 0 Then    'Put a comma before appending new email address if the
                        '                            taken email id is not the first one
                        StrOutPut = StrOutPut & ", "
                    End If
                    StrOutPut = StrOutPut & m.ToString()
                    lblCount.Text = lblCount.Text + 1
                End If
                m = m.NextMatch()
            End While
        Next i
        StrOutPut = StrOutPut.Remove(StrOutPut.LastIndexOf(",") + 1, 0)
 
        txtResult.Text = StrOutPut
 
        MsgBox("Completed")
 
    End Sub
 
    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        lblCount.Text = 0
    End Sub
End Class

Imports System.Text.RegularExpressions
‘Import name space for regular expressions.
Dim textstring As Array
Dim strEmail As String
Dim strEmailChars As String
Dim StrOutPut As String = ""

strEmail = txtMailContent.Text
StrOutPut = txtResult.Text

strEmailChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_@."

For cnt As Long = 0 To strEmail.Length - 1  'Loop throug each charecters in the content
 
'Check whether the charecter is anything other than valid email charecters
'(Charecters in the strins "strEmailChars")
If strEmailChars.Contains(strEmail(cnt)) = False Then
strEmail = strEmail.Replace(strEmail(cnt), " ") 'Replace that String with space
End If
Next

textstring = Split(strEmail) ' no delimeter means use space

Dim emailpattern As String = "^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"

Dim r As New Regex(emailpattern, RegexOptions.IgnoreCase + RegexOptions.Multiline)

For i = 0 To textstring.GetLength(0) - 1
Dim m As Match = r.Match(textstring(i))
 
While m.Success
If StrOutPut.Contains(m.ToString) = False Then
If StrOutPut.Length > 0 Then    'Put a comma before appending new email address if the
'                            taken email id is not the first one
StrOutPut = StrOutPut & ", "
End If
 
StrOutPut = StrOutPut & m.ToString()
lblCount.Text = lblCount.Text + 1
End If
m = m.NextMatch()
End While
Next i

StrOutPut = StrOutPut.Remove(StrOutPut.LastIndexOf(",") + 1, 0)

txtResult.Text = StrOutPut