Private Sub Command2_Click()
  Dim i As Long
  Dim sLink As String
  Dim suchtxt As String
 
suchtxt = "http://www.microsoft.de"
 
  List1.Clear
  With WebBrowser1.Document.All
    For i = 0 To .Tags("A").Length - 1
      sLink = Trim$(.Tags("A")(i).href)
      If sLink <> "" Then
 
        If sLink <> "" And LCase$(Left$(sLink, 7)) <> "mailto:" Then
        If InStr(sLink, suchtxt) > 0 Then
        List1.AddItem sLink
            End If
    End If
    End If
 
    Next i
 
  End With
 
  If List1.ListCount = 0 Then
    List1.AddItem "keine URL-Links vorhanden"
  End If
End Sub