CODEWITHSUNDEEP
excelvba
Stefan Jung
Stefan Jung

Reputation: 1268

Finding whole word/URL in a string

I'm creating an ADODB stream object to write content to a file. I'm doing an on-the-fly to HTML conversion. What I could not find out so far is, how can I automatically wrap URLs in <a> tags?

For example, I have a string like:

Foo bar https://www.google.com foo bar.

I can search for the https:// but how can I match/select the whole URL with VBA?

Dim fs As Object
Set fs = CreateObject("ADODB.Stream")
fs.Type = 2
fs.Charset = "utf-8"
fs.Open

fs.WriteText mystring
    
fs.SaveToFile filename, 2

Thanks a lot in advance.

Stefan

Upvotes: 0

Views: 84

Answers (1)

Stefan Jung
Stefan Jung

Reputation: 1268

Thanks a lot, @Raymond Wu and wellsr.com (see Introduction to VBA RegEx article). This has helped.

My solution is:

Function htmlConform(x As String)

    Dim debugging As Boolean
    debugging = False

    htmlConform = Replace(x, "<", "&lt;")
    htmlConform = Replace(x, ">", "&gt;")
    htmlConform = Replace(x, "&", "&amp;")
    
    Dim r As Match
    Dim mcolResults As MatchCollection
    
    Dim strPattern As String
    strPattern = "(https:\/\/[\S]{1,})"
    Set mcolResults = RegEx(x, strPattern, , , True)
    
    If Not mcolResults Is Nothing Then
        For Each r In mcolResults
            htmlConform = Replace(x, r, "<a href='" & r & "'>link</a>")
            If debugging = True Then Debug.Print "RegEx match: " & r
        Next r
    End If

End Function

'***************************************************************************
' Regex function wrapping the Regex object from "Microsoft VBScript Regular Expressions 5.5" Object Library
'***************************************************************************
Function RegEx(strInput As String, strPattern As String, _
    Optional GlobalSearch As Boolean, Optional MultiLine As Boolean, _
    Optional IgnoreCase As Boolean) As MatchCollection
    
    Dim mcolResults As MatchCollection
    Dim objRegEx As New RegExp
    
    If strPattern <> vbNullString Then
        
        With objRegEx
            .Global = GlobalSearch
            .MultiLine = MultiLine
            .IgnoreCase = IgnoreCase
            .Pattern = strPattern
        End With
    
        If objRegEx.Test(strInput) Then
            Set mcolResults = objRegEx.Execute(strInput)
            Set RegEx = mcolResults
        End If
    End If
End Function

Upvotes: 2

Related Questions