ChlankMail: Extract Email Addresses From Any Text

Sometimes you need to extract email addresses from text or documents or even from emails like “you will stay luckless for 3 years, if you do not forward this mail to 10 of your friends”. Task is easy if you have few couples of addresses, but once it becomes to tens or sometimes more, that would be a pain in the ass.

What I’m proposing here is a program that does the job on the fly; you just need to copy the text and paste it, then click a button. Here is the source:

    Private Sub cmd_chlank_Click(ByVal sender As System.Object,_
    ByVal e As System.EventArgs) Handles cmd_chlank.Click
        If Source.Text <> "" Then
            Dim Sep As String = " =<>()%$#!*^[]{}/\'" + vbCrLf + """"
            Dim SS As String = Source.Text
            Dim DT As String = ""
            Dim LeftStr As String = ""
            Dim RightStr As String = ""
            Dim P As Integer = 1
            Dim Pos, PLeft, PRight As Integer
            Dim DetectedMail As String = ""
            Dim MailsCount As Integer = 0
            Destination.Text = ""
            Do
                Pos = InStr(P, SS, "@")
                If Pos = 0 Then GoTo TakeMeOut
                PLeft = Pos
                PRight = Pos
                Do
                    PLeft = PLeft - 1
                    If Sep.Contains(SS.Substring(PLeft, 1)) Then
                        LeftStr = SS.Substring(PLeft + 1, Pos - PLeft - 2)
                        PLeft = 0
                    Else
                        If PLeft = 0 Then LeftStr = SS.Substring(0, Pos - 1)
                    End If
                Loop Until PLeft = 0
                Do
                    PRight = PRight + 1
                    If PRight = SS.Length Then
                        RightStr = SS.Substring(Pos, PRight - Pos)
                        DetectedMail = LeftStr + "@" + RightStr
                        If InStr(DT, DetectedMail) = 0 Then
                            DT = DT + DetectedMail + vbCrLf
                            MailsCount += 1
                        End If
                        GoTo TakeMeOut
                    End If
                    If Sep.Contains(SS.Substring(PRight, 1)) Then
                        RightStr = SS.Substring(Pos, PRight - Pos)
                        P = PRight + 1
                        PRight = 0
                    End If
                Loop Until PRight = 0
                DetectedMail = LeftStr + "@" + RightStr
                If InStr(DT, DetectedMail) = 0 Then
                    DT = DT + DetectedMail + vbCrLf
                    MailsCount += 1
                End If
            Loop While Pos <> 0
TakeMeOut:
            Destination.Text = DT
            lb_MailsCount.Text = MailsCount
        End If
    End Sub

Code is not optimized I know, it was a very quick thing, but you can share your comments here to improve it and make it more compatible with RFC’s. You are free to do whatever you want with this code and with the program, it would be nice if you drop me a line if you find it useful but I’m not responsible of the use you will make of (yeah, I mean: DO NOT USE IT TO SPAM PEOPLE).

Download the program here.
Download the complete VB.NET project (source code)
To run the program, you need Microsoft .Net Framework V2.0

ChlankMail: Extract Email Addresses From Any Text

Categories

Recent Posts