모든 하위 도메인 허용 목록 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