Option Explicit
 
Public Function Get_Text(ByVal sText As String) As Collection
Const sPatern                   As String = "\<div class\=""col_titulo col_superior"" \>\s*(.+)\s*\<\/div\>"
Dim cTemp                       As New Collection
Dim oRegExp                     As Object
Dim oMatch                      As Object
Dim oMatches                    As Object
Dim Q                           As Long
 
    Set oRegExp = CreateObject("VBScript.RegExp")
 
    With oRegExp
        .Pattern = sPatern
        .Global = True
        .IgnoreCase = True
    End With
 
    Set oMatches = oRegExp.Execute(sText)
 
    For Q = 0 To oMatches.Count - 1
        Set oMatch = oMatches(Q)
        cTemp.Add oMatch.SubMatches(0)
    Next Q
 
    Set Get_Text = cTemp
End Function
'Sub que extrae las direccións url : Http, Ftp y Https _
 de un archivo utilizando una expresión regular
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Sub Extraer_Url(url_Path As String, Expresion As String)
    'Variables para usar RegExp
    Dim o_RegExp As RegExp
    Dim o_Match As Match
    Dim o_Matches As MatchCollection
   'Variables Fso para abrir y leer el archivo en la variable contenido
   Dim Contenido As String
   'Lee el contenido del fichero y lo almacena en la var
   Contenido = Text2.Text
   'crea nuevo objeto RegExp
   Set o_RegExp = New RegExp
   ' Para que no distinga mayúsculas de minúsculas
   o_RegExp.IgnoreCase = True
   o_RegExp.Global = True
   ' A la propiedad Pattern se le pasa la Expresión regular
   o_RegExp.Pattern = Expresion
   'Ejecuta y busca
   Set o_Matches = o_RegExp.Execute(Contenido)
   ' Recorre en la colección
   For Each o_Match In o_Matches
      'Agrega las url al control List
      List1.AddItem Replace(o_Match.Value, Chr(34), vbNullString)
   Next
 
End Sub
 
Private Sub Command1_Click()
    Dim Expresion As String
    ' Expresión regular
    Expresion = "\<div class\=\""col_titulo col_superior\""\>(.+)\<\/div\>"
        Call Extraer_Url(Text2.Text, Expresion)
    Text1.Text = List1.List(0)
    List1.Clear
End Sub
 
Private Sub Command2_Click()
Text2.Text = WebBrowser1.Document.documentElement.innerHTML
End Sub
 
Private Sub Command3_Click()
    Dim vItem                   As Variant
Dim S                       As String
    S = Text1.Text
 
    For Each vItem In Get_Text(S)
        Text3.Text = vItem
    Next vItem
End Sub
 
Private Sub Form_Load()
WebBrowser1.Navigate ("http://www.rinconjuegos.com/just-jhon/")
    Me.Caption = " Ejemplo que utiliza expresiones regulares" _
                 & " Para extraer los enlaces de un archivo"
 
    Command1.Caption = " Abrir archivo y Extraer "
End Sub
 

Dim S                       As String
    S = Text1.Text
 
    MsgBox Get_Text(S)