Extraer texto de la etiqueta <font></font> [SRC]

[<[(x)]>]

holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>.

En un modulo:

Código (vb) [Seleccionar] Expandir



Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)

Dim strText() As String: ReDim strText(0) As String
Dim strBuf As String
Dim bol As Boolean: bol = False

strBuf = strData

Do While Not bol

If InStr(LCase(strBuf), "<font") > 0 Then
   
  strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
   
  If InStr(LCase(strBuf), ">") > 0 Then
   
   Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
   
   If InStr(LCase(strBuf), "</font") > 0 Then
   
    Dim intb As Integer
     
    intb = InStr(LCase(strBuf), "</font") - inta
    PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
     
    strBuf = Mid(strBuf, inta)
   
   Else
   
    bol = True
   
   End If
   
  Else
   
   bol = True
   
  End If
   
Else
 
  bol = True
   
End If

Loop

ReDim strArrayOut(UBound(strText)) As String

strArrayOut = strText

End Sub

Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)

Dim lngP As Long

lngP = UBound(strArray) + 1

ReDim Preserve strArray(lngP)

strArray(lngP) = strPlus

End Sub





Y para probarlo en un form:

Código (vb) [Seleccionar] Expandir



Private Sub Form_Load()

Dim x As Integer
Dim strText As String
Dim strArrayText() As String

strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"

ExtractText strText, strArrayText

Me.Print "Prueba:"
Me.Print ""
Me.Print ""

For x = 0 To UBound(strArrayText)
 
  Me.Print "    " & strarraytext(x)

Next

End Sub



Bue no se, se puede usar si quieres hacer una búsqueda en una web.

54¬U|)()5

[seba123neo]

Hola, funciona bien, pero corregile la linea

Código (vb) [Seleccionar] Expandir

Me.Print "    " & strArrayText(x)

te falto una "r"....

y usa la etiqueta de codigo de visual , asi queda mas lindo el codigo..creo que la funcion podria tener menos codigo, si puedo ahora lo veo...

saludos.

[<[(x)]>]

holas

Gracias por la corrección.

  y cual es la etiqueta que me decís?


------------------------------------

oks gracias

[seba123neo]

cuando creas un post tenes al lado un combo que dice "Geshi" ahi elegis el lenguaje para el codigo...

[el_c0c0]

holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>.

En un modulo:

Código (vb) [Seleccionar] Expandir



Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String)

Dim strText() As String: ReDim strText(0) As String
Dim strBuf As String
Dim bol As Boolean: bol = False

strBuf = strData

Do While Not bol

If InStr(LCase(strBuf), "<font") > 0 Then
   
  strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font"))
   
  If InStr(LCase(strBuf), ">") > 0 Then
   
   Dim inta As Integer: inta = InStr(LCase(strBuf), ">")
   
   If InStr(LCase(strBuf), "</font") > 0 Then
   
    Dim intb As Integer
     
    intb = InStr(LCase(strBuf), "</font") - inta
    PlusArray strText, Mid(strBuf, inta + 1, intb - 1)
     
    strBuf = Mid(strBuf, inta)
   
   Else
   
    bol = True
   
   End If
   
  Else
   
   bol = True
   
  End If
   
Else
 
  bol = True
   
End If

Loop

ReDim strArrayOut(UBound(strText)) As String

strArrayOut = strText

End Sub

Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String)

Dim lngP As Long

lngP = UBound(strArray) + 1

ReDim Preserve strArray(lngP)

strArray(lngP) = strPlus

End Sub





Y para probarlo en un form:

Código (vb) [Seleccionar] Expandir



Private Sub Form_Load()

Dim x As Integer
Dim strText As String
Dim strArrayText() As String

strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>"

ExtractText strText, strArrayText

Me.Print "Prueba:"
Me.Print ""
Me.Print ""

For x = 0 To UBound(strArrayText)
 
  Me.Print "    " & strarraytext(x)

Next

End Sub



Bue no se, se puede usar si quieres hacer una búsqueda en una web.

54¬U|)()5

estas haciendo cagadas, mira cuantas lineas al dope.

asi vas a hacer errores (creeria que no) y/o tardar mucho

usa la funcion TEXTINBETWINE (de cobein, pero le pegue una modificacion yo)

Código (vb) [Seleccionar] Expandir

Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String
    If InStr(sData, sStart) > 0 Then
        sData = Mid(sData, InStr(sData, sStart) + Len(sStart))
        TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1)
    End If
End Function

tene cuidado, si no existe el tag de cerrado, va a tirar error
la funcion trabaja asi:
encuentra la primer coincidencia, y hace que llegue hasta la primer coincidencia final
llama a la funcion asi

Código (vb) [Seleccionar] Expandir

TextInBetwinE("<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font>  <font > un pedo </font>", "<font >", "</font>")
eso te devuelve el primer tag..
para sacar el segundo tag, hace un replace a la cadena original, sacando el tag actual y hace asi hasta q no haya mas tags

saludos

[<[(x)]>]

Bien coco.


Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.

me parece que tu método no funcionaria ahi.

[el_c0c0]

Bien coco.


Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.

me parece que tu método no funcionaria ahi.

para eso necesitas un parser, a lo xml o algo asi!

para hacer que funcione con ese ejemplo, modifica y pone asi:

Código (vb) [Seleccionar] Expandir

TextInBetwinE(".... ", "<font ", "</font>")
y te quedaria

color="#DD6600">blablabla

saludos

[<[(x)]>]

jej..holas

  Explicitame lo de ''un parser, a lo xml o algo asi!''

  y si no se optiene el mismo resultado,.. no me cirbe.

[xkiz ™]

<[(X)]> mira este link, creo que ese ejemplo te puede servir para lo que queres hacer...

SimpleXMLParserSimpleXMLParser ( PSC )

[el_c0c0]

jej..holas

  Explicitame lo de ''un parser, a lo xml o algo asi!''

  y si no se optiene el mismo resultado,.. no me cirbe.

yo te digo, usa el parser.. usa el que te paso xkiz.
parser es una herramienta que entiende un texto o lo que sea, segun lo que uno quiera sacar...
en este caso un parser xml. xml porque es mas o mismo que html, pero bueno.

si vos queres q te devuelva lo mismo, imaginatelas. No es dificil!!!!!

Código (vb) [Seleccionar] Expandir


Dim strRet As String
strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>")

If Left(strRet, 1) = ">" Then
strRet = Right(strRet, Len(strRet) -1)
Else
strRet = Right(strRet, Len(strRet) - InStr(strRet, ">"))
End If



asi lo sacas. pero la proxima fijate vos eso.. que no es nada dificil

saludos