[Resolvido] Localizar qualquer URL e criar link

[xanburzum 169]

Localiza qualquer URL encontrado dentro de texto especificado e cria um link para http, https, ftp, e endereços de e-mail.

 

Function LinkURLs(ByRef asContent)
        Dim loRegExp    ' Regular Expression
        
        ' Se o conteúdo não foi recebida, sair da função
        If asContent = "" Then Exit Function
        
        ' Criar um objecto de Expressões Regulares
        Set loRegExp = New RegExp
        
        ' Manter links encontrar depois da primeira                
        loRegExp.Global = True
        
        ' Ignorar upper/lower case
        loRegExp.IgnoreCase = True
        ' Procure por URLs
        loRegExp.Pattern = "((ht|f)tps?://\S+[/]?[^\.])([\.]?.*)"
        ' Link URLs
        LinkURLs = loRegExp.Replace(asContent, "<A href=""$1"">$1</A>$3")
        ' Procure por endereços de e-mail
        loRegExp.Pattern = "(\S+@\S+.\.\S\S\S?)"
        ' Link para endereços de e-mail
        LinkURLs = loRegExp.Replace(LinkURLs, "<A href=""mailto:$1"">$1</A>")
        ' Lançando objeto de expressão regular
        Set oRegExp = Nothing
        
    End Function