Function ToLink (Str)
Dim re' Regular Expression object
Dim strContent
If IsNull (Str) Then Str = ""
Set RE = New RegExp 'create a regular expression object
With RE
. Global = true' search applies to the entire string
. IgnoreCase = true' search case-insensitive
StrContent = Str
'*************************************** ************************
'Mail Address link is automatically set
'*************************************** ************************
. Pattern = "([w] *) @ ([w.] *)"
StrContent =. Replace (strContent, "<A Href = 'mailto: $1 @ $2 '> $1 @ $2 </A> ")
'*************************************** ************************
'Automatic link settings
'*************************************** ************************
'====== Add the protocol name as required ======
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, "<A Href = '" + D (I) + ": // $1 'target = _ blank>" + D (I) + ": // $1 </A> ")
Next
'*************************************** ************************
End
Set RE = Nothing
ToLink = strContent
End Function