VBA, URL to Root Domain

Public Function ReverseString(text As String)
    ReverseString = StrReverse(text)
End Function

Public Function getRootDomain(text As String)
    Dim i
   
    ' Remove protocol
    text = Replace(text, "http://", "")
    text = Replace(text, "https://", "")
    text = Replace(text, "ftp://", "")
   
    ' Remove trailing / and path
    i = InStr(text, "/")
    If (i > 0) Then
        text = Left(text, InStr(text, "/") - 1)
    End If
   
    If Left(Right(text, 5), 1) = "." Then     '  info TLD
   
        If InStr(6, ReverseString(text), ".") > 0 Then
            text = Right(text, InStr(6, ReverseString(text), ".") - 1)
        Else
            text = Replace(text, "www.", "")
        End If
   
    ElseIf Left(Right(text, 4), 1) = "." Then   '.xxx TLD
   
        If InStr(5, ReverseString(text), ".") > 0 Then
            text = Right(text, InStr(5, ReverseString(text), ".") - 1)
        Else
            text = Replace(text, "www.", "")
        End If
   
    Else
        'xxx.TLD.uk
        If Left(Right(text, 7), 1) = "." Then
            If InStr(8, ReverseString(text), ".") > 0 Then
                text = Right(text, InStr(8, ReverseString(text), ".") - 1)
            Else   'we don't not handle http://www.wp.pl/ case well
                text = Replace(text, "www.", "")
            End If
   
        'xxx.xx.uk
        ElseIf Left(Right(text, 6), 1) = "." Then
            If InStr(7, ReverseString(text), ".") > 0 Then
                text = Right(text, InStr(7, ReverseString(text), ".") - 1)
            Else   'we don't not handle http://www.wp.pl/ case well
                text = Replace(text, "www.", "")
            End If
   
        Else  'xxxx.uk
       
            If InStr(4, ReverseString(text), ".") > 0 Then
                text = Right(text, InStr(4, ReverseString(text), ".") - 1)
            Else
                text = Replace(text, "www.", "")
            End If
           
   
        End If
      
   
    End If
   
   
    getRootDomain = text
End Function