如何把URL和邮件地址转换为超级链接?

    Function InsertHyperlinks(inText)
    Dim objRegExp, strBuf
    Dim objMatches, objMatch
    Dim Value, ReplaceValue, iStart, iEnd

      strBuf = “”
      iStart = 1
      iEnd = 1
      Set objRegExp = New RegExp

      objRegExp.Pattern = “\b(www|http|\S+@)\S+\b” 

    判断URLsemails.
      objRegExp.IgnoreCase = True                 

    设置大小写不敏感..
      objRegExp.Global = True                     

    全局适用.
      Set objMatches = objRegExp.Execute(inText)
      For Each objMatch in objMatches
        iEnd = objMatch.FirstIndex
        strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1)
        If InStr(1, objMatch.Value, “@”) Then
          strBuf = strBuf & GetHref(objMatch.Value, “EMAIL”, “_BLANK”)
        Else
          strBuf = strBuf & GetHref(objMatch.Value, “WEB”, “_BLANK”)
        End If
        iStart = iEnd+objMatch.Length+1
      Next
      strBuf = strBuf & Mid(inText, iStart)
      InsertHyperlinks = strBuf
    End Function

    Function GetHref(url, urlType, Target)
    Dim strBuf

      strBuf = “<a href=”””
      If UCase(urlType) = “WEB” Then
        If LCase(Left(url, 3)) = “www” Then
          strBuf = “<a href=””URL:” & url & “””超级链接:””” & _
                  Target & “””>” & url & “</a>”
        Else
          strBuf = “<a href=””” & url & “””
    超级链接:””” & _
                  Target & “””>” & url & “</a>”
        End If
      ElseIf UCase(urlType) = “EMAIL” Then
        strBuf = “<a href=””
    电子邮件地址:” & url & “””链接目标:””” & _
                Target & “””>” & url & “</a>”
      End If
      GetHref = strBuf
    End Function

     

     

    [1]