白名單所有子域名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