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:
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:
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
Hola, funciona bien, pero corregile la linea
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.
holas
Gracias por la corrección.
y cual es la etiqueta que me decís?
------------------------------------
oks gracias
cuando creas un post tenes al lado un combo que dice "Geshi" ahi elegis el lenguaje para el codigo...
Cita de: <[(x)]> en 2 Febrero 2009, 00:42 AM
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:
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:
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)
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 Functiontene 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
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
Bien coco.
Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.
me parece que tu método no funcionaria ahi.
Cita de: <[(x)]> en 2 Febrero 2009, 13:41 PM
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:
TextInBetwinE(".... ", "<font ", "</font>") y te quedaria
Citarcolor="#DD6600">blablabla
saludos
jej..holas
Explicitame lo de ''un parser, a lo xml o algo asi!''
y si no se optiene el mismo resultado,.. no me cirbe.
<[(X)]> mira este link, creo que ese ejemplo te puede servir para lo que queres hacer...
SimpleXMLParserSimpleXMLParser ( PSC ) (http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=64975&lngWId=1)
Cita de: <[(x)]> en 3 Febrero 2009, 05:13 AM
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!!!!!
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
holas
coco:
jej no es por nada pero el code que pusistes no se parece al que puse yo?
....
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)
...
y lo qpusistes:
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
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
Cita de: <[(x)]> en 3 Febrero 2009, 05:58 AM
holas
coco:
jej no es por nada pero el code que pusistes no se parece al que puse yo?
....
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)
...
y lo qpusistes:
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
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
me puedo remitir a mi 1º comentario que decia que eran muchas lineas al dope. y nose si pensas que te copie, que este en todo tu derecho, pero yo se que no.
en fin, para estos casos, yo usaria el parser...
no solo porque busca cualquier tag, tipo fonto o div, lo q sea.. en si porque devuelve los parametros del tag, como en tu ejemplo el parametro "color" ademas del contenido del tag...
saludos
oks
xkiz:
muy bueno el ej...