白名单所有子域名VBA宏

Question

我已经实现了一个宏在Outlook电子邮件中的任何超链接之前追加一个字符串。然而，我把一个域名白名单工作正常，例如，如果我将https：//google.com列入白名单，那么除了https：//google.com/etc ..以及其后的任何内容，它都会将其列入白名单。

我的问题是，如果有人想访问https://mail.google.com或任何其他子域，它将无法正常工作，并将其附加到APPEND_THIS_https：//mail.google.com。我如何允许所有子域名在白名单中？

Dim myStr As String 
    Dim myURL As String 
    ' Declare whitlist URL variables 
    'Dim whiteURL01 As String 
    'Dim whiteURL02 as string 

    myURL = "APPEND_THIS_" 
    ' Add URLs to whitelist here 
    whiteURL01 = "https://google.com" 

    ' Store the HTML Bodyin a variable 
    myStr = Msg.htmlbody 
    ' Update all URLs 
    myStr = Replace(myStr, "href=""", "a href=" & myURL, , , vbTextCompare) 

    ' Process whitelist 
    myStr = Replace(myStr, myURL & whiteURL01, whiteURL01, , , vbTextCompare) 

    ' Assign back to HTML Body 
    Msg.htmlbody = myStr 
    ' Save the mail 
    Msg.Save 

Answer 1

这是我该怎么做的。我添加了一个额外的循环来查看整个消息体，以防有多个循环。

Dim myStr As String 
Dim myURL As String 
Dim white_url_found As Boolean 

myStr=Msg.HTMLBody 
myURL = "APPEND_THIS_" 

Dim whiteURL(0 To 2) As String 

whiteURL(0) = ".google.com" 
whiteURL(1) = ".facebook.com" 
whiteURL(2) = "mailto:" 

searchstart = InStr(1, myStr, "href=") 
While searchstart <> 0 
    nextstart = InStr(searchstart + 1, myStr, "href=") 
    white_url_found = False 
    For i = LBound(whiteURL()) To UBound(whiteURL()) 
     URL_pos = InStr(searchstart, myStr, whiteURL(i)) 
     If URL_pos > 0 And (URL_pos < nextstart Or nextstart = 0) Then 
      white_url_found = True 
      Exit For 
     End If 
    Next i 
    If Not white_url_found Then 
     myStr = Left(myStr, searchstart - 1) & Replace(myStr, "href=" & Chr(34), "href=" & Chr(34) & myURL, searchstart, 1, vbTextCompare) 
     If nextstart <> 0 Then nextstart = nextstart + Len(myURL) 
    End If 

    searchstart = nextstart 
Wend 
Msg.HTMLBody = myStr 
Msg.Save