Convert multiple addresses [An Answer]

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

Hello Dudes,

Instead of my first trial to get somehelp, I have now the created the
solution. However, Don Pyers helped me out with a great start!

So if you are ever in a piggle and need to replace
http://www.blabla.com addresses because your boss wants it ... here
comes the solution.

Dim strText, strReturned, strSearchString, strEndStringChars, strStartPos, strEndPos, strLength

Function subPullStrings(strText)

If  instr(strText,"http:") = 0 Then

 If len(strTextToReplace) = 0 then

    subPullStrings = strText

    Exit Function

 End If

End If

strText = Replace(strText,"http://www.","*66775588*")

strText = Replace(strText,"www.","*66775588*")

strText = Replace(strText,"*66775588*","http://www.")

Do while instr(strText,"http:") > 0

 strSearchString = "http:"

 strEndStringChars = " "

    strLength = 0

    strStartPos = instr(1, strText, strSearchString)

    strEndPos = instr(strStartPos + 1, strText, strEndStringChars)

    strLength = strEndPos - strStartPos

    strReturned = mid(strText,strStartPos + len(strSearchString),strLength - len(strSearchString) ) 

    strStartPos = strEndPos + 1

     strVisit = strReturned

     strVisit = Replace(strVisit,"http:","")

     strVisit = Replace(strVisit,"//","")

     strVisit = Replace(strVisit,"www.","")

     tempVisit = Split(strVisit,".")

     strVisit = tempVisit(0)

    strFinal = " <a href=""*444555*" + strReturned +
""" target=""_blank"" title=""Visit: " + strVisit + """>" &
strVisit & "</a> "

   strFinal = Replace(strFinal,"'","")

   strFinal = Replace(strFinal,",","")

   strFinal = Replace(strFinal,"&","&amp;")

  strText = Replace(strText,"http:" & strReturned,strFinal)

Loop

  strText = Replace(strText,"*444555*","http:")

 subPullStrings = strText

End Function

Addresses can start with or HTTP: or WWW. 

strMeString = "this is great stuff and can be found at http://www.webwiz.net and that is just great!"

strMeString = strMeString + " "

Next is to apply the function like this:

subPullStrings(strMeString)

et voila!

Happy coding ye all 

Edited by C.P.A. - 28 April 2005 at 2:21pm