Vb extract url

gistfile1.txt

' Returns every hyperlink in the cell (Address or SubAddress), newline-separated.
Function GetAllURLs(cell As Range) As String
    Dim h As Hyperlink, out As String, one As String
    If cell Is Nothing Then Exit Function
    
    ' Case 1: Rich text hyperlinks (pasted from web, like ServiceNow)
    If cell.Hyperlinks.Count > 0 Then
        For Each h In cell.Hyperlinks
            one = h.Address
            If one = "" Then one = h.SubAddress          ' internal/bookmark/mailto
            If one <> "" Then out = out & one & vbLf
        Next h
        If Len(out) > 0 Then out = Left$(out, Len(out) - 1) ' drop last LF
        GetAllURLs = out
        Exit Function
    End If
    
    ' Case 2: HYPERLINK() formula
    If cell.HasFormula Then
        Dim f As String: f = cell.Formula
        Dim q1 As Long, q2 As Long
        q1 = InStr(1, f, """")
        If q1 > 0 Then
            q2 = InStr(q1 + 1, f, """")
            If q2 > q1 Then
                GetAllURLs = Mid$(f, q1 + 1, q2 - q1 - 1)
                Exit Function
            End If
        End If
    End If
    
    ' No link found -> return empty string (avoid 0)
    GetAllURLs = ""
End Function