Cómo extraer todas las URL de una cadena

Estaba ayudando en una discusión en el foro en la que un desarrollador estaba pidiendo ayuda para obtener una lista de URL que se encuentran dentro de una serie de texto y pensé en compartir aquí las soluciones que se me ocurrió, ya que estoy seguro de que no es el primero, ni el último en necesitar hacer este tipo de cosas.

Expresiones regulares (regex) al rescate

De inmediato, sabía que la solución más simple, cuando hablamos de trabajar con patrones (en nuestro caso http (s): // www …), sería usar expresiones regulares (regex). Así que vine aquí a mi blog, tomé una de mis rutinas existentes, modificé el código, reemplazé el patrón et voilà! El resultado fue:

'---------------------------------------------------------------------------------------
' Procedure : ExtractURLs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' 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) - 
' 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

Solución pura de VBA

Con el temor de que Regex avance el camino del dodo gracias a que Microsoft elimine a VBScript en los próximos años y no explique explícitamente las implicaciones en bibliotecas como FSO, Regex, …, pensé que también explorar brevemente tratar de hacer lo mismo, pero usar VBA puro. Como tal, se me ocurrió la siguiente función:

'---------------------------------------------------------------------------------------
' Procedure : ExtractURLs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' 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) - 
' 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)) = " Or _
           LCase(Left(sElement, 8)) = " 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

Ejemplo de uso

Ambas funciones están construidas exactamente de la misma manera. Proporciona un texto, especifica el separador para usar si no sea una coma y devuelve una cadena de URL encontradas. Por ejemplo:

? ExtractURLs("How can I improve my writing skills see  and 

que sale

,

O, si lo prefiere, puede hacer:

? ExtractURLs("How can I improve my writing skills see  and  VbCrLf)

que sale

Así que ahí lo tienes, un par de formas rápidas de extraer una lista de URL de una cadena usando regex o vBa de vainilla simple.