Private Sub ListarUrl()
 
 Dim i As Integer
 
       List1.Clear
        For i = 0 To wb1.Document.links.length - 1
          List1.AddItem wb1.Document.links.Item(i)
          List2.AddItem wb1.Document.All.tags("a").Item(i).innerText
       Next
 End Sub
 

'by Mr.Frog™
Public Function TextBetweenWords(ByRef strText$, ByRef strWord1$, ByRef strWord2$) As String
Dim lngPos1&, lngPos2&, lngStart&
 
    lngPos1 = InStr(strText, strWord1)
    If lngPos1 Then
        lngStart = lngPos1 + LenB(strWord1) \ 2
        lngPos2 = InStr(lngStart, strText, strWord2)
        If iPosition2 Then
            TextBetweenWords = Mid$(strText, lngStart, lngPos2 - lngStart)
        End If
    End If
End Function

Private Sub Form_Load()
    Msgbox TextBetweenWords("<a href=""xfire:add_friend?user=mrdogbertt""><img class=", "<a href=""", """><img class=")
End Sub

xfire:add_friend?user=mrdogbertt

'by Mr.Frog™
Public Function GetXFireText(ByRef strText$) As String()
Dim objMatches As Object, objRegExp As Object
Dim strTmp$(), lngTotal&, Q&
 
    Set objRegExp = CreateObject("VBScript.RegExp")
 
    With objRegExp
        .Pattern = "\<a href\=""(\S+)""\>\<img class\="
        .Global = True
        .IgnoreCase = True
    End With
 
    Set objMatches = objRegExp.Execute(strText)
 
    lngTotal = objMatches.Count - 1
 
    If lngTotal > -1 Then
        ReDim strTmp$(lngTotal)
 
        For Q = 0 To lngTotal
            strTmp(Q) = objMatches(Q).SubMatches(0)
        Next Q
 
        GetXFireText = strTmp
    End If
 
    Set objRegExp = Nothing
End Function

Private Sub Form_Load()
    Text1.Text = "<a href=""xfire:add_friend?user=mrdogbertt""><img class=" '// Text1 -> contenido html
    Text2.Text = Join$(GetXFireText(Text1.Text), vbCrLf)                    '// Text2 -> textbox destino
End Sub