Function ToLink(Str)

Dim RE '正则表达式对象

Dim strContent

If IsNull(Str) Then Str=""

Set RE = New RegExp '创建正则表达式对象

With RE

.Global = True '搜索应用于整个字符串

.IgnoreCase = True '搜索不区分大小写的

strContent=Str

'***************************************************************

'邮件地址链接自动设置

'***************************************************************

.Pattern="([\w]*)@([\w\.]*)"

strContent=.Replace(strContent,"$1@$2 ")

'***************************************************************

'链接自动设置

'***************************************************************

'======根据要求再添加协议名称=======

Dim D(3),I

D(0)="http"

D(1)="ftp"

D(2)="news"

D(3)="mms"

'===================================

For I=0 To UBound(D)

.Pattern=D(I) + ":\/\/([\w\.]*)"

strContent=.Replace(strContent,"" + D(I) + "://$1 ")

Next

'***************************************************************

End With

Set RE=Nothing

ToLink=strContent

End Function