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

将所有子域名列入白名单VBA宏

1 个答案: