Imprimir página | Cerrar ventana

VBA que localice texto y grabe en Excel

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Word
Descripción del foro: Foro de Word
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=83989
Fecha de impresión: 22/Agosto/2019 a las 19:49


Tema: VBA que localice texto y grabe en Excel
Publicado por: giorgio-10
Asunto: VBA que localice texto y grabe en Excel
Fecha de publicación: 02/Octubre/2018 a las 13:10
Hola
Tengo un fichero txt o doc, con un mogollón de texto. Hay un patrón que quiero extraer. Esta montado como un XML pero mal formateado y por eso no puedo cortarlo como si fuera un XML.

Quiero generar un Excel con 2 columnas donde grabe determinados textos. En concreto en el ejemplo que mando cogería 15 y 2325.80

...<OrgnlNbOfTxs>15</OrgnlNbOfTxs><OrgnlCtrlSum>2325.80</OrgnlCtrlSum>.....

Se me ocurre que el VBA vaya leyendo todo el texto y cuando encuentre "<OrgnlNbOfTxs>" coge lo que esta entre eso y "</OrgnlNbOfTxs>. Lo mismo para el otro campo. Y que lo vaya guardando en un Excel fila a fila en dos columnas.

¿Se os ocurre como?
Gracias
sauldos



Respuestas:
Publicado por: prga
Fecha de publicación: 02/Octubre/2018 a las 16:39
Hola.
Sin entrar en otras posibilidades y ya que estamos en el foro de word y por dar ideas prueba con:

Sub sacavalores()
Dim n As Long
Dim mexcel As Object
Set mexcel = CreateObject("excel.application")
mexcel.Visible = True
mexcel.Workbooks.Add
mexcel.Sheets.Add
n = 0
Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<OrgnlNbOfTxs\>*\</OrgnlNbOfTxs\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Do While Selection.Find.Execute
    n = n + 1
    mivalor = Selection.Range.Text
    mivalor = Replace(mivalor, "<OrgnlNbOfTxs>", "")
    mivalor = Replace(mivalor, "</OrgnlNbOfTxs>", "")
    mexcel.ActiveSheet.Cells(n, 1).Value = Trim(mivalor)
      If n > 1000 Then
       Exit Do
      End If
    Loop
    
End Sub

Se supone que el "texto" está en el documento word.
Aclaraciones: El texto a buscar tiene \ que hacen que el siguiente carácter sea tal como se ve y no un inicio o fin de palabra. El if dentro del bucle no es más que una manera de salir( 1000 ciclos) por si se entra en un bucle infinito. La búsqueda del otro valor no se contempla.
Todo es a título de ejemplo y el código tiene falta de depurar, optimizar , etc etc
Espero que sirva como idea
Pruébalo y ya comentas
Un saludo a todos



Imprimir página | Cerrar ventana