¿Podrias ubicarme el error para la extracción de campo especifico de archivo xml?

Para Dante

Sub ExtraerFolioFiscal()
Dim MiPc, Carpeta, Archivos, Archivo
Dim y, Fila, FolioFiscal
Application.ScreenUpdating = False
Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Carpeta = MiPc.GetFolder(Range("B1").Value)
Set Archivos = Carpeta.Files
For Each Archivo In Archivos
If LCase(Right(Archivo.Name, 4)) = ".xml" Then
Workbooks.OpenXML Filename:=Archivo
y = 1: FolioFiscal = ""
Do Until Cells(2, y) = ""

If Trim(Cells(2, y)) = "/@folio" Then
folio = Cells(3, y)
End If

'este es el campo que necesito que me extraiga la retención ISR
If Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Retenciones/cfdi:Retencion/@importe" Then
retencionimporte = Cells(3, y)
End If

'este es el campo que necesito que me extraiga la retención IVA
If Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Retenciones/cfdi:Retencion/@impuesto" Then
retencionimpuesto = Cells(3, y)
End If
y = y + 1
Loop
Range("P" & Fila) = retencionimporte
Range("Q" & Fila) = retencionimpuesto
Fila = Fila + 1
End If
Next
End Sub

Me interesa dos campo que es la retención de ISR e IVA.

1 Respuesta

Respuesta
1

Envíame otro archivo de excel y me dices qué datos son los que buscas y en dónde los quieres poner, utiliza colores y comentarios para identificar los datos.

Te anexo la macro actualizada

Sub ExtraerFolioFiscal()
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    Set h2 = l1.Sheets("impuestos")
    h2.Cells.Clear
    fila = 2
    Set MiPc = CreateObject("Scripting.FileSystemObject")
    Set Carpeta = MiPc.GetFolder(h1.Range("B1").Value)
    Set Archivos = Carpeta.Files
    n = Archivos.Count
    m = 0
    For Each Archivo In Archivos
        m = m + 1
        Application.StatusBar = "Procesando archivo : " & m & " de : " & n
        If LCase(Right(Archivo.Name, 4)) = ".xml" Then
            Workbooks.OpenXML Filename:=Archivo
            Set l3 = ActiveWorkbook
            Set h3 = l3.Sheets(1)
            y = 1
            Do Until h3.Cells(2, y) = ""
                If Trim(h3.Cells(2, y)) = "/@folio" Then
                    folio = h3.Cells(3, y)
                End If
                'este es el campo que necesito que me extraiga la retención ISR
                If Trim(h3.Cells(2, y)) = "/cfdi:Impuestos/cfdi:Retenciones/cfdi:Retencion/@importe" Then
                    retencionimporte = h3.Cells(3, y)
                    retencionimpuesto = h3.Cells(4, y)
                End If
                'este es el campo que necesito que me extraiga la retención IVA
                'If Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Retenciones/cfdi:Retencion/@impuesto" Then
                '    retencionimpuesto = Cells(3, y)
                'End If
                y = y + 1
            Loop
            l3.Close False
            h2.Range("A" & fila) = folio
            h2.Range("P" & fila) = retencionimporte
            h2.Range("Q" & fila) = retencionimpuesto
            fila = fila + 1
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    h2.Select
    MsgBox "Fin    "
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas