Como puedo modificar este macro para que extraiga más partes del xml

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
FolioFiscal = Cells(3, y)
Exit Do
End If
y = y + 1
Loop
'--
Archivo = ActiveWorkbook.Name
ActiveWorkbook.Close
Range("A" & Fila) = FolioFiscal
Range("B" & Fila) = Archivo
Fila = Fila + 1
End If
Next

End Sub

1 respuesta

Respuesta
4

¿Puedes compartirme el xml?, ¿Para poder comprender mejor tu duda?

[email protected]

Recibi tu email

La macro seria algo asi:

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
            FolioFiscal = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Emisor/@rfc" Then
            EmisorRfc = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Emisor/@nombre" Then
            EmisorNombre = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Receptor/@nombre" Then
            ReceptorNombre = Cells(3, y)
         End If
         y = y + 1
      Loop
      '--
      Archivo = ActiveWorkbook.Name
      ActiveWorkbook.Close
      Range("A" & Fila) = Archivo
      Range("B" & Fila) = FolioFiscal
      Range("C" & Fila) = EmisorRfc
      Range("D" & Fila) = EmisorNombre
      Range("E" & Fila) = ReceptorNombre
      Fila = Fila + 1
   End If
Next
End Sub

No coloque todas las columnas que querías, para que tu comprendas mejor como modificar el codigo.

Si quieres agregar otras columnas debes de seguir estos 3 pasos:

1.Identificar nombre de la columna en el XML

Solo debes identificar el nombre exacto de la columna. Para esto abre el XML desde excel: Cuando te pregunte "Seleccione como desea abrir este archivo" le das "Como libro de solo lectura"

por ejemplo el rfc emisor es: "/cfdi:Emisor/@nombre"

2. Extraer del XML el campo

Vas a la macro y agregas estas tres lineas antes de la instruccion y = y + 1

If Trim(Cells(2, y)) = "Nombre Columna" Then
NombreVariable = Cells(3, y)
End If

Donde Nombre Columna es el nombre exacto que identificamos en el punto 1.

Donde NombreVariable es un nombre a tu gusto para identificar temporalmente el campo mientras lo enviamos al Excel.

3.Enviar al Excel

Finalmente agregas  una linea de codigo antes de la instruccion       Fila = Fila + 1

Range("A" & Fila) = NombreVariable

Donde NombreVariable es la que asignaste en el punto2 y cambias "A" por la columna que quieres que aparezca.

Y listo!

Si tienes alguna duda o tienes alguna dificultad, no dudes en preguntarme. No se te olvide dar por finalizada la pregunta.

Te adjunto el xls con alguna columnas

http://1drv.ms/1QDclXL 

¡Gracias! Muchas gracias brother, ya tenia rato buscando la respuesta, y por fin la encontré, gracias por tu resolución del macro, no hubiera podido haberlo solucionado sin su ayuda

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas