+ Reply to Thread
Results 1 to 2 of 2

Problema en leer archivo xml

  1. #1
    Registered User
    Join Date
    08-07-2018
    Location
    Cucuta, Colombia
    MS-Off Ver
    2019 y Office 365
    Posts
    25

    Unhappy Problema en leer archivo xml

    Este es el código original

    Hola a todos los que me puedan ayudar a resolver este problema.

    Buscando encontré un archivo que lee archivos xml de un directorio seleccionado para luego pasarlo a una hoja de excel, el problema surgió cuando quise copiar todo el código en un archivo nuevo y proceder a testear; ya he revisado que tenga estén habilitadas las mismas referencias de las librerías, pero nada que encuentro el detalle.

    Una parte del código me daba interrupción en esta línea:

    HTML Code:
    "ruta = LCase(CreateObject([explorador]).BrowseForFolder(0, "selecciona la carpeta a procesar", 0, "").items.Item.Path)"
    y luego consultando hice este cambio:
    HTML Code:
    "ruta = LCase(CreateObject("shell.application").BrowseForFolder(0, "selecciona la carpeta a procesar", 0, "").Items.Item.Path)"
    y funcionó , pero luego volvió a parar en la línea:
    HTML Code:
    "With CreateObject([openFile])"
    Si ejecuto el archivo original funciona todo bien.

    Pero la idea era hacerle unos cambios para adaptarlo a mis necesidades.

    Adjunto los archivos para probar "XML to Excel original" y este es el de duplicado "test2 XML" y el .zip están los xml para probar.

    Mil gracias al que me de una mano

    HTML Code: 
    Sub procesaXML()
    '
    ' procedimiento para rescatar informacion de facturas ' _
      desde archivos .XML -cualquier version- certificados por el SAT (caso México) ' _
      R&D: Héctor Miguel Orozco Díaz (septiembre de 2017) '
    '
    '-------------------------------------------------------------------------------------------------
    
      Dim ruta As String
      On Error Resume Next
      
      ruta = LCase(CreateObject([explorador]).BrowseForFolder(0, "selecciona la carpeta a procesar", 0, "").Items.Item.Path)
      On Error GoTo 0
      If ruta = "" Then CreateObject([mensaje]).PopUp "operación cancelada", 2, "sin selección": Exit Sub
    '-------------------------------------------------------------------------------------------------
    
      Dim archivo As String
      archivo = LCase(Dir(ruta & "\*.xml"))
      If archivo = "" Then CreateObject([mensaje]).PopUp "no se encontraron archivos xml", 2, "Error": Exit Sub
    '-------------------------------------------------------------------------------------------------
    
      Dim fila, largo, largo2 As Integer
      Dim contenido, col, fin, dato, fin2, x As Byte
      Dim pre, campo As String
      Dim ini, ini2 As Long
      
      fila = 3
      
      Application.ScreenUpdating = False
      [a3].Resize(, [counta(titulos)]) = [Titulos]
      With CreateObject([openFile])
        .Charset = [mx]
      Do While archivo <> ""
      
      fila = fila + 1
      
          .Open
          .LoadFromFile ruta & "\" & archivo
          contenido = .ReadText()
          .Close: Cells(fila, 1) = archivo
          
          For col = 2 To 20
          pre = " "
          Select Case col
          Case 13
          pre = "receptor "
          Case 14
          pre = dato & """ "
          End Select
          campo = pre & Application.Index([tags], col) & "="
            If InStr(1, contenido, campo, 1) Then
              fin = Len(campo)
              ini = InStr(1, contenido, campo, 1) + fin + 1
              largo = InStr(ini, contenido, Chr(34), 1) - ini
              dato = Mid(contenido, ini, largo)
              If campo Like "*fecha*" Then dato = Replace(dato, "T", " ")
              If col < 16 Then dato = LCase(dato)
              Cells(fila, col) = dato
            Else
              Select Case col
              Case 8
              campo = [form]
              Case 9
              campo = [met]
              Case 19
              campo = [trIva]
              End Select
              If InStr(1, contenido, campo, 1) Then
                fin = Len(campo)
                ini = InStr(1, contenido, campo, 1) + fin + 1
                largo = InStr(ini, contenido, Chr(34), 1) - ini
                dato = Mid(contenido, ini, largo)
                Cells(fila, col) = LCase(dato)
              End If
              End If
              Next
              campo = [ieps]
              
          If InStr(1, contenido, campo, 1) Then
            ini = InStr(1, contenido, campo, 1) + 1
            largo = InStr(ini, contenido, Chr(34), 1) - ini
            campo = " importe="
            fin2 = Len(campo)
            ini2 = InStr(ini + largo, contenido, campo, 1) + largo + fin2 + 1
            largo2 = InStr(ini2, contenido, Chr(34), 1) - ini2
            dato = Mid(contenido, ini2, largo2)
            Cells(fila, col) = dato
            With Cells(fila, col - 2)
            .Value = .Value - dato
            End With
            End If
            
          For x = 1 To [counta(isr)]
          campo = Application.Index([isr], x)
            If InStr(1, contenido, campo, 1) Then
              fin = Len(campo): ini = InStr(1, contenido, campo, 1) + fin + 1
              largo = InStr(ini, contenido, Chr(34), 1) - ini
              Cells(fila, col + 1) = Mid(contenido, ini, largo)
              Exit For
              End If
              Next
              
          For x = 1 To [counta(iva)]
          campo = Application.Index([iva], x)
            If InStr(1, contenido, campo, 1) Then
              fin = Len(campo)
              ini = InStr(1, contenido, campo, 1) + fin + 1
              largo = InStr(ini, contenido, Chr(34), 1) - ini
              Cells(fila, col + 2) = Mid(contenido, ini, largo)
              Exit For
              End If
              Next
              
          archivo = LCase(Dir())
          Loop
          End With
          ActiveSheet.ListObjects.Add(xlSrcRange, [a3].CurrentRegion, , xlYes).Name = Format(Now, [lstName])
      With [a3].CurrentRegion
      .Offset(, 15).Resize(, 8).NumberFormat = [mon]
      .EntireColumn.AutoFit
      End With
    '-------------------------------------------------------------------------------------------------
    
    ' Convertir Tabla a Rango
    
        Columns("A:Z").Select 'remplazar el segundo argumento por la columna final del rango
        Selection.Copy
        Range("AA1").Select 'selecciona el inicio del rango
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Columns("A:Z").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Rows("1:2").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
        
        [x1] = ruta
    '-------------------------------------------------------------------------------------------------
    
        Call ColumnasAdicionales 'agregar columnas adicionales
    
    '-------------------------------------------------------------------------------------------------
    
        Call FormatoTabla 'Da el formato final a las columnas
        
    '-------------------------------------------------------------------------------------------------
    
      End Sub

  2. #2
    Registered User
    Join Date
    08-07-2018
    Location
    Cucuta, Colombia
    MS-Off Ver
    2019 y Office 365
    Posts
    25

    Re: Problema en leer archivo xml

    Adjunte nuevamente los archivos porque no los ví.
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Crear un archivo de Excel (.XLS y .XLSX) desde C#
    By epsilonmag in forum Non English Excel
    Replies: 1
    Last Post: 10-17-2020, 04:59 PM
  2. Replies: 1
    Last Post: 10-17-2019, 09:33 PM
  3. Problema esportazione Excel in CSV con VBA
    By MORRO1991P in forum Non English Excel
    Replies: 1
    Last Post: 05-25-2018, 05:08 AM
  4. Problema combobox
    By gigi1965 in forum Hello..Introduce yourself
    Replies: 4
    Last Post: 03-10-2013, 11:44 PM
  5. Problema na Contagem de Valor
    By sgps in forum Excel General
    Replies: 1
    Last Post: 08-22-2006, 01:25 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1