How can I extract a domain (TLD and second level domains) but ignore subdomains?

I'm running a VBA macro on outlook that will extract the domain from an email message. What I have works well, but only extracts everything after the "@" sign, so the subdomain gets included in the link, throwing off my sort. But not every address has a subdomain, so I have to be flexible enough accommodate both.

Here are the results that I am getting from sample email addresses:

[email protected] returns xyz.com
[email protected] returns subdomain.xyz.com

I want both email addresses to return xyz.com.

The string I am using is:

sDomain = Right(oMail.SenderEmailAddress, Len(oMail.SenderEmailAddress) - InStr(1, oMail.SenderEmailAddress, "@"))

Perhaps there is a way to extract the TLD using the last dot and then concatenate it with the second level domain in front of that dot, but because the second level domain might have either an ampersand or a dot, I can't figure out a formula that will accommodate both.

I appreciate your help!

Solution

Try something like this (but take note of Dmitry's answer...)

Sub DomainTester()
    Dim a
    For Each a In Array("xyz.com", "[email protected]", "[email protected]", "A@xyz")
        Debug.Print a, Domain(a)
    Next a
End Sub

Function Domain(addr) As String
    Dim arr
    If InStr(addr, "@") > 0 Then
        arr = Split(Split(addr, "@")(1), ".")
        If UBound(arr) > 0 Then Domain = arr(UBound(arr) - 1) & "." & arr(UBound(arr))
    End If
End Function