VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ContactObj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Const EmailRE = "[\w\.]+@[\w\.]+\.(edu|com|org|gov)"
Const PhoneRE = "(\(\d{3}\)\s*|\d{3}([ -/\.]))\d{3}([ -/\.])\d{4}(\s*(ext\w*|x)\.?\s*\d+)?"
Const PhoneHintsRE = ".*" + PhoneRE + ".*"
Const AddrRE = "\d+.*\n(.*\n){0,3}.*,\s*.*[\s\n\240]*\d{5}(-\d{4})?"
Const EmptyRE = "^\s*\n"
Const NameRE = "^.*"
Const TitleRE = "^.*\n"
Const CompanyRE = "^.*\n"
Const PhoneHint_Cell = "mobile|cell|\bc\b|\bm\b"
Const PhoneHint_Fax = "fax|\bf\b"
Const PhoneHint_Work = "work|bus|\bw\b|\bb\b"
Const PhoneHint_Home = "home|\bh\b"

Public Note As String

Private p_name As String
Private p_emails(3) As String
Private p_phones(4) As String
Private p_address As String
Private p_title As String
Private p_company As String

Private Sub SetFirst(ByRef prop, match As MatchCollection)
    If match.count > 0 Then
        prop = chomp(match.item(0).Value)
    Else
        Debug.Print "WARN: prop count not 1 but " + str(match.count)
    End If
End Sub
Public Property Set Company(match As MatchCollection)
    SetFirst p_company, match
End Property
Public Property Get Company() As String
    Company = p_company
End Property
Public Property Set Title(match As MatchCollection)
    SetFirst p_title, match
End Property
Public Property Get Title() As String
    Title = p_title
End Property
Public Property Set Address(match As MatchCollection)
    SetFirst p_address, match
End Property
Public Property Get Address() As String
    Address = p_address
End Property
Public Property Set Phones(matches As MatchCollection)
    Dim c, item
    Dim numbers As MatchCollection
    Dim phone_number As String
    
    For Each item In matches
        Set numbers = xReplace(item.Value, PhoneRE)
        phone_number = numbers.item(0).Value
        
        If IsMatch(item.Value, PhoneHint_Work) Then
            p_phones(0) = phone_number
        ElseIf IsMatch(item.Value, PhoneHint_Fax) Then
            p_phones(1) = phone_number
        ElseIf IsMatch(item.Value, PhoneHint_Cell) Then
            p_phones(2) = phone_number
        ElseIf IsMatch(item.Value, PhoneHint_Home) Then
            p_phones(3) = phone_number
        Else
            For c = 0 To 3
                If p_phones(c) = "" Then
                    p_phones(c) = phone_number
                    Exit For
                End If
            Next
        End If
    Next
End Property

Public Property Get PhoneWork() As String
    PhoneWork = p_phones(0)
End Property
Public Property Get PhoneFax() As String
    PhoneFax = p_phones(1)
End Property
Public Property Get PhoneMobile() As String
    PhoneMobile = p_phones(2)
End Property
Public Property Get PhoneHome() As String
    PhoneHome = p_phones(3)
End Property

Public Property Set Emails(c As MatchCollection)
    Dim count, match
    
    count = 0
    For Each match In c
        If count <= c.count And count < 3 Then
            p_emails(count) = match.Value
        End If
        count = count + 1
    Next
End Property

Public Property Get Email1() As String
    Email1 = p_emails(0)
End Property
Public Property Get Email2() As String
    Email2 = p_emails(1)
End Property
Public Property Get Email3() As String
    Email3 = p_emails(2)
End Property

Public Property Set Name(c As MatchCollection)
    SetFirst p_name, c
End Property
Public Property Get Name() As String
    Name = p_name
End Property

Public Function to_string()
    Dim str As String
    Dim i
    
    For Each i In Name
        str = str + "Name: " + i.Value
    Next
    
    to_string = str
End Function

Private Function chomp(ByRef s As String)
    If Right(s, 1) = Chr(10) Then
        s = Left(s, Len(s) - 1)
    End If
    chomp = s
End Function

Public Function Parse(str As String)
    Dim orig As String
    
    'PrintCoded str
    ConvertNewlines str
    'PrintCoded str
    
    StripEmpties str
    orig = str
    
    Set Emails = xReplace(str, EmailRE)
    Set Phones = xReplace(str, PhoneHintsRE)
    Set Address = xReplace(str, AddrRE)
    Set Name = xReplace(str, NameRE)
    Set Title = xReplace(str, TitleRE)
    Set Company = xReplace(str, CompanyRE)
    Note = orig + Chr(10) + "Unused:" + Chr(10) + str
    
End Function

Private Function xReplace(ByRef str As String, regex_str As String) As MatchCollection
    Dim re As RegExp
    Dim matches As MatchCollection
    
    Set re = New RegExp
    re.Pattern = regex_str
    re.IgnoreCase = True
    re.Global = True
    ' re.MultiLine = True
    
    Set matches = re.Execute(str)
    str = re.Replace(str, "")
    
    Set xReplace = matches
End Function

Private Sub ConvertNewlines(ByRef str As String)
    Dim re As RegExp
    Set re = New RegExp
    re.Pattern = Chr(13) + Chr(10)
    re.Global = True
    re.MultiLine = True
    str = re.Replace(str, Chr(10))
End Sub

Private Sub StripEmpties(ByRef str As String)
    Dim re As RegExp
    Set re = New RegExp
    re.Pattern = EmptyRE
    re.Global = True
    re.MultiLine = True
    str = re.Replace(str, "")
End Sub

Private Function IsMatch(str As String, regex As String) As Boolean
    Dim match As MatchCollection
    Dim re As RegExp
    Set re = New RegExp
    re.Pattern = regex
    re.IgnoreCase = True
    Set match = re.Execute(str)
    If match.count > 0 Then
        IsMatch = True
    Else
        IsMatch = False
    End If
        
End Function