Imports System.IO
Imports System.Threading

Module Module1

    Sub Main()

        Dim dirPath As String = My.Application.Info.DirectoryPath

        Dim validAlfabeticFirstChars As Char() = "abcdefghijklmnopqrstuvwxyz"
        Dim charDict As SortedDictionary(Of String, List(Of String))
        Dim lineCount As Integer = 0

        For Each f As FileInfo In New DirectoryInfo(dirPath).GetFiles("*.txt", SearchOption.TopDirectoryOnly)

            charDict = New SortedDictionary(Of String, List(Of String))
            Debug.WriteLine(f.FullName)

            Dim firstChar As String

            For Each line As String In File.ReadLines(f.FullName)
                lineCount += 1

                If line.Contains(":") Then
                    line = line.Split(":").First()
                End If
                line = line.Replace(" "c, "").Trim({" "c, ControlChars.Tab, ControlChars.NullChar, ControlChars.Quote, ControlChars.Back}).ToLower()

                If (String.IsNullOrWhiteSpace(line)) OrElse
                   (Not line.Contains("@")) OrElse
                   (line.Count(Function(c) c = "@"c) <> 1) Then
                    Continue For
                End If

                firstChar = line(0)
                Select Case firstChar

                    Case validAlfabeticFirstChars.ToArray()
                        If Not charDict.ContainsKey(firstChar) Then
                            charDict.Add(firstChar, New List(Of String))
                        End If
                        charDict(firstChar).Add(line)

                    Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
                        If Not charDict.ContainsKey("0-9") Then
                            charDict.Add("0-9", New List(Of String))
                        End If
                        charDict("0-9").Add(line)
                        firstChar = "0-9"

                    Case Else
                        Continue For

                End Select

                If (lineCount = 20000000) Then ' 20 Million

                    For Each kv As KeyValuePair(Of String, List(Of String)) In charDict
                        kv.Value.Sort(StringComparer.Ordinal)
                        kv.Value.Add(Environment.NewLine)
                        File.AppendAllLines("C:\Mail Lists\" & If(kv.Key.Length = 1, Char.ToUpper(kv.Key), kv.Key) & ".txt", kv.Value)
                        kv.Value.Clear()
                        kv = Nothing
                    Next
                    charDict.Clear()
                    GC.Collect()
                    GC.WaitForFullGCComplete(Timeout.Infinite)
                    lineCount = 0
                End If

            Next

            For Each kv As KeyValuePair(Of String, List(Of String)) In charDict
                kv.Value.Sort(StringComparer.Ordinal)
                kv.Value.Add(Environment.NewLine)
                File.AppendAllLines("C:\Mail Lists\" & If(kv.Key.Length = 1, Char.ToUpper(kv.Key), kv.Key) & ".txt", kv.Value)
                kv.Value.Clear()
                kv = Nothing
            Next
            charDict.Clear()
            charDict = Nothing
            GC.Collect()
            GC.WaitForFullGCComplete(Timeout.Infinite)

            ' File.Delete(f.FullName)
        Next

        MsgBox("Done !")
    End Sub

End Module