如何把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"
' 判断URLs和emails.
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]
- DataGrid的超级链接列如何设置多个url字段?
- jquery分析文本里url或邮件地址为真实链接的方法
- WSS 3.0如何控制外发邮件链接地址?
- 在GridView中使用邮件地址的超级链接
- 把文本中的URL地址转换为可点击链接的JavaScript、PHP自定义函数
- swt Browser 如何打开新url链接地址
- swt Browser 如何打开新url链接地址
- 如何用JavaScript隐藏一个超级链接真实的地址?
- 如何把手机上的CSDN链接地址转换成电脑上的
- java获取一段文字的url地址并以链接的形式显示在网页上
- 如何获取Flickr图片链接地址作为外链图片
- 如何更改outlook邮件附件的默认保存地址
- 用Javascript隐藏超级链接的真实地址
- 黄聪:用python知道URL地址提取链接中的域名与端口
- 如何准确判断邮件地址是否存在
- 如何将rdba转换成数据文件的地址
- 如何修改Git仓库的URL(地址)
- 正则表达式匹配URL——给URL地址加上<a> 链接