I was helping out in a forum discussion in which a developer was asking for assistance in getting a listing of URLs found within a string of text and thought I’d share here the solution(s) I came up with as I’m sure he’s not the first, nor the last to need to do this type of thing.
 

Regular Expressions (RegEx) to the Rescue

Right off the bat, I knew the simplest solution, when we talking about working with patterns (in our case http(s)://www…), would be to use Regular Expressions (RegEx). So I came here to my blog, pulled up one of my existing routines, tweaked the code, replaced the pattern et voilà! The result was:

'---------------------------------------------------------------------------------------
' Procedure : ExtractURLs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract a list of URL from a string
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Early Binding -> Microsoft VBScript Regular Expressions X.X
'             Late Binding  -> None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput    : The string to extract a listing of URLs from
' sSeparator: String to be used as a separator between match values ",", ", ", VbCrLf
'
' Returns:
' ~~~~~~~~~~~~~~~~
' String of matches
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2025-06-04              Forum Help
'---------------------------------------------------------------------------------------
Function ExtractURLs(ByVal sInput As String, _
                     Optional sSeparator As String = ",") As String
    On Error GoTo Error_Handler
    #Const RegEx_EarlyBind = False   'True => Early Binding / False => Late Binding
                                     ' Normally this should be a module level variable
    #If RegEx_EarlyBind = True Then
        Dim oRegEx            As VBScript_RegExp_55.RegExp
        Dim oMatches          As VBScript_RegExp_55.MatchCollection

        Set oRegEx = New VBScript_RegExp_55.RegExp
    #Else
        Dim oRegEx            As Object
        Dim oMatches          As Object

        Set oRegEx = CreateObject("VBScript.RegExp")
    #End If
    Dim sResult               As String
    Dim iCounter              As Integer

    With oRegEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "(https?://[^\s,]+|www\.[^\s,]+|\b[\w-]+\.[a-z]{2,}(?:/[^\s,]*)?)"
    End With

    If oRegEx.Test(sInput) Then
        Set oMatches = oRegEx.Execute(sInput)
        For iCounter = 0 To oMatches.Count - 1
            sResult = sResult & oMatches(iCounter).Value
            If iCounter < oMatches.Count - 1 Then
                sResult = sResult & sSeparator
            End If
        Next iCounter
    End If

    ExtractURLs = sResult

Error_Handler_Exit:
    On Error Resume Next
    Set oMatches = Nothing
    Set oRegEx = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: ExtractURLs" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

Pure VBA Solution

With the fears of RegEx going the way of the Dodo thanks to Microsoft phasing out VBScript in the coming years and not explicitly explaining the implications on libraries such as FSO, RegEx, …, I thought I’d also briefly explore trying to do the same thing, but using pure VBA. As such, I came up with the following function:

'---------------------------------------------------------------------------------------
' Procedure : ExtractURLs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract a list of URL from a string
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sInput    : The string to extract a listing of URLs from
' sSeparator: String to be used as a separator between match values ",", ", ", VbCrLf
'
' Returns:
' ~~~~~~~~~~~~~~~~
' String of matches
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2025-06-04              Forum Help
'---------------------------------------------------------------------------------------
Function ExtractURLs(ByVal sInput As String, _
                     Optional sSeparator As String = ",") As String
    On Error GoTo Error_Handler
    Dim colURLs               As Collection
    Dim aElements()           As String
    Dim sElement              As String
    Dim lCounter              As Long

    Set colURLs = New Collection      ' Used to avoid duplicates
    aElements = Split(sInput, " ")    ' Split string on spaces

    For lCounter = LBound(aElements) To UBound(aElements)
        sElement = aElements(lCounter)    ' Individual word/element

        ' Remove trailing punctuation
        Do While Len(sElement) > 0 And InStr(".,;:!?)""", Right(sElement, 1)) > 0
            sElement = Left(sElement, Len(sElement) - 1)
        Loop

        ' Check if the Element is a URL or not
        If LCase(Left(sElement, 7)) = "http://" Or _
           LCase(Left(sElement, 8)) = "https://" Or _
           LCase(Left(sElement, 4)) = "www." Then
            colURLs.Add sElement, sElement
        End If
    Next lCounter

    ' ***** An alternative would be to simply return the Collection here *****

    ' Build CSV string
    If colURLs.Count > 0 Then
        For lCounter = 1 To colURLs.Count
            If ExtractURLs <> "" Then _
               ExtractURLs = ExtractURLs & sSeparator
            ExtractURLs = ExtractURLs & colURLs(lCounter)
        Next lCounter
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set colURLs = Nothing
    Exit Function

Error_Handler:
    If Err.Number = 457 Then
        'This key is already associated with an element of this collection
        'Duplicate URL
        Resume Next
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Source: ExtractURLs" & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
        Resume Error_Handler_Exit
    End If
End Function

 

Usage Example

Both functions are built in the exact same manner. You supply a text, specify the separator to use if other than a comma and it returns string of URLs found. For instance:

? ExtractURLs("How can I improve my writing skills see https://writingtips.com and https://grammarbook.com")

which outputs

https://writingtips.com,https://grammarbook.com

Or, if you prefer you can do:

? ExtractURLs("How can I improve my writing skills see https://writingtips.com and https://grammarbook.com", VbCrLf)

which outputs

https://writingtips.com
https://grammarbook.com

 
 
So there you have it, a couple quick ways to extract a list of URLs from a string using either RegEx or plain vanilla VBA.