Excel VBA filter primary domain name

Sub Filtersitedomain ()
 Dim Siteurl As   String 
 Dim Sitedomain As   String 
 Dim Sitemaindomain As   String 
Siteurl = "  Http://www.baidu.com/a/ B /index.html  " 
'  Get URL Domain Name  
 Sitedomain = getsitebyurl (siteurl)
 Msgbox Sitedomain
 '  Obtain the URL primary domain name  
 Sitemaindomain = getsitedomain (sitedomain)
 Msgbox Sitemaindomain
 End sub 


 '  Back to primary domain  
 Function Getsitedomain (sitedomain As   String )
 Dim Domain As   String 

 '  Convert the obtained domain name to lowercase  
 Domain = Lcase (Sitedomain)

 If   Instr (Domain, " .  " )> 0   Then 
 Dim Domainarr () As   String 
Domainarr = Split (Domain, "  .  " )

 Dim Laststr As   String 
Laststr = domainarr ( Ubound (Domainarr ))
 If   Isnumeric (Laststr) Then 
Getsitedomain = Replace (Domain, "  .  " , "" )
 Else 
 Dim Domainrules () As  String 
Domainrules = Split ( "  .Com.cn | .net.cn | .org.cn | .gov.cn |. com |. net |. CN |. org |. CC |. me |. tel |. moBi |. asia |. biz |. info |. name |. TV |. HK |. company |. china |. network  " , "  |  " )
 Dim Findstr As   String 
 Dim ReplacestrAs   String 
 Dim Returnstr As   String 
Findstr = "" 
Replacestr = "" 
Returnstr = "" 

 Dim I As   Integer 
 For I =0   To   Ubound (Domainrules)
 '  If a match is found at the end  
                  If Endswith (domain, Lcase (Domainrules (I ))) Then 
 '  Www.baidu.com  
 Findstr = domainrules (I)
 '  Replace the matching item with null to facilitate further judgment 
 Replacestr = Replace (Domain, findstr, "" )
 '  Second-level domain name or third-level domain name, such as www. Baidu  
                      If   Instr (Replacestr, "  .  " )> 0   Then 
 Dim Replacearr ()As   String 
 '  WWW Baidu  
 Replacearr = Split (Replacestr, "  .  " )
Returnstr = replacearr ( Ubound (Replacearr) + findstr
 '  Getsitedomain = returnstr  
                         Exit   For 
 Else   '  Baidu  
                          '  Output after connection: Baidu.com  
 Returnstr = replacestr + findstr
 '  Getsitedomain = returnstr  
                          Exit   For 
 End  If 
 Else 
Returnstr = domain
 End   If 

 Next I

Getsitedomain = returnstr

 End   If 

 Else 
Getsitedomain = domain
 End   If 


 End Function 

 '  Return protocol, domain name, port number, page  
  Function Getsitebyurl (URL As   String ) As   String 
 Dim RegEx As   Object 
 Set RegEx = Createobject ( "  VBScript. Regexp  " )
RegEx. Global = True 
RegEx. pattern = "  (\ W +): // ([^/:] +) (: \ D *)? ([^ #] *)  " 
 '  Msgbox RegEx. Replace (URL, "use protocol/primary domain name/port number/Page: [$1], [$2], [$3], [$4]")  
 Getsitebyurl = RegEx. Replace (URL, "  $2  " )
 End Function 


 '  Does strtarget start with strcom?  
  Function Startswith (strtarget As   String , Strcom As   String ) As   Boolean 
Startswith = ( Left (Strtarget, Len (Strcom) = strcom)
 End Function 

 '  Whether strtarget ends with strcom  
  Function Endswith (strtarget As   String , Strcom As   String ) As   Boolean 
Endswith = ( Right (Strtarget, Len (Strcom) = strcom)
 End Function