URLs2Anchors

All links found inside a string into anchor (< a href=...)
BUG!: Currently converts all links, even those that are already inside < a > and , this should be fixed in newer version

CodeFunctionName
What is this?

Public

Tested

Original Work
Function URLs2Anchors(inTextBlock)
' All links found inside a string into ancher ( < a href=...)
' Needs CreateAncher, RemoveHTML (or RemoveHTMLTags)
' BUG!: Currently converts all links, even those that are within < a > and </a >
' inText = RemoveHTML(inTextBlock)
inText = RemoveHTMLTags(inTextBlock)
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" ' Match URLs and emails
objRegExp.IgnoreCase = True ' Set case insensitivity.
objRegExp.Global = True ' Set global applicability.
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 & CreateAncher(objMatch.Value, "EMAIL", "_BLANK", "")
Else
strBuf = strBuf & CreateAncher(objMatch.Value, "WEB", "_BLANK", "")
End If
iStart = iEnd + objMatch.Length + 1
Next
strBuf = strBuf & Mid(inText, iStart)
URLs2Anchors = strBuf
End Function

inTextBlock

Views 4,944

Downloads 1,431

CodeID
DB ID