注册
登录
白名单
将所有子域VBA宏列入白名单
返回
将所有子域VBA宏列入白名单
作者:
春风助手
发布时间:
2024-12-21 08:48:24 (8天前)
<p>我已经实现了一个宏，以便在Outlook电子邮件中的任何超链接之前附加字符串。但是，我放了一个域名白名单，例如，如果我将https：// //google.com列入白名单，那么它会很好地工作，然后除https：//google.com/etc。之外，它还会将其列入白名单。</p><p>我的问题是，如果有人想访问https://mail.google.com或任何其他子域，它将无法正常工作，并将其附加为APPEND_THIS_https：//mail.google.com。如何允许所有子域都列入白名单？</p> <pre><code>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 </code></pre>
收藏
举报
2 条回复
1#
回复此人
只怕再见是故人
|
2020-08-03 18-17
这就是我要怎么做。我添加了一个额外的循环来查看整个邮件正文，以防出现多个循环。 ``` 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 ```
编辑
登录
后才能参与评论
