Necesito que se jale información de archivos .XML de facturas y que aparezcan en excel
Necesito llevar un control de las facturas de varias personas, que se encuentran en carpetas individuales, las facturas son de México vienen en formato XML. Necesito que en un libro de excel, aparezca el detalle de las facturas, una HOJA por persona, y que contenga la fecha de la factura, concepto, razón social, cantidad, y que se actualice de forma automatica para que cuando alguien agregue un XML a su carpeta, entonces cuando se abra el excel, aparezca esa factura en su hoja que le corresponde junto con el listado de sus demás facturas.
1 Respuesta
¿Aun necesitas esa información amigo?
Así es todavía, me ayudaría muchísimo si tienes la respuesta
Amigo tengo este macro que de hecho ya lo tienen muchas personas pero, el que lo subió por primera vez y de ahí se han estado modificando muchos compañeros en el foro saludos, si gustas extraer más conceptos contáctame ami correo y con mucho gusto te ayudo okey saludos. [email protected]
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
