為字串中的網址加上鍊接的程式例子 (轉)

為字串中的網址加上鍊接的程式例子 (轉)[@more@]

  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)=""
  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