Que tal [uSER=9984]@rolano[/uSER] gracia por la información y espero no te moleste que ocupe tu código para ayudar a alguien mas, crees que nos puedas ayudar para que cuando la macro detecte estos problemas no se detenga por completo la ejecución y termine de procesar los archivos que si están bien ?? ya que actualmente también utilizo esta macro para importar mis archivos xml pero muchas veces se presenta este tipo de errores.
Saludos
Sub ExtraerFolioFiscal()
Dim MiPc, Carpeta, Archivos, Archivo, Registro, Registros
Dim y, Fila, FolioFiscal
Dim Contador As Integer
Dim cuenta As Integer
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 Registros = Carpeta.Files
Set Archivos = Carpeta.Files
'-------Cuenta la cantidad de archivos en la carpeta ----------------------------
For Each Registro In Registros
cuenta = cuenta + 1
Next Registro
'---------------------------------------------------------------------------------
For Each Archivo In Archivos
Contador = 1
On Error GoTo ErrorXml
If LCase(Right(Archivo.Name, 4)) = ".xml" Then
Workbooks.OpenXML (Archivo)
y = 1: FolioFiscal = ""
Do Until Cells(2, y) = ""
If Trim(Cells(2, y)) = "/@fecha" Then
FECHAS = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@version" Then
XMLVERSION = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/@rfc" Then
RFCRECEPTOR = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/@nombre" Then
RECEPTORN = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/@nombre" Then
ENOMBRE = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/@rfc" Then
EMISORRFC = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@serie" Then
SERIE = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@formaDePago" Then
FPAGO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@metodoDePago" Then
MPAGO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@folio" Then
FOLIO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@municipio" Then
LEXPEDICION = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@estado" Then
ESTADO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@pais" Then
PAIS = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@codigoPostal" Then
CODIGOPOSTAL = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:RegimenFiscal/@Regimen" Then
RFISCAL = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Complemento/tfd:TimbreFiscalDigital/@UUID" Then
UUID = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@NumCtaPago" Then
NCUENTAPAGO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@calle" Then
CALLE = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@noExterior" Then
NEXTERIOR = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Emisor/cfdi:DomicilioFiscal/@colonia" Then
COLONIA = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@calle" Then
CALLERECEP = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@noExterior" Then
RECEPNOEXT = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@colonia" Then
RECEPCOLONIA = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@municipio" Then
RECEPMUNICIPIO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@estado" Then
RECEPESTADO = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@pais" Then
RECEPPAIS = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Receptor/cfdi:Domicilio/@codigoPostal" Then
RECEPCPOSTAL = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@total" Then
Total = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@subTotal" Then
Subtotal = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/@Moneda" Then
MONEDA = Cells(3, y)
ElseIf Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Traslados/cfdi:Traslado/@tasa" Then
TASA = Cells(3, y)
Next
Exit Sub
ErrorXml:
'Range("A" & Fila) = "Error XML"
'Range("B" & Fila) = Archivo
Dim sRuta As String, aDatos() As String, i As Integer
sRuta = Archivo
' abrimos el archivo para lectura y cargamos cada linea en la matriz
Open sRuta For Input As #1
aDatos = Split(Input(LOF(1), #1), Chr(32))
Close #1
' modificamos las lineas ten en cuenta que el primer elemento de
' la matriz es el cero)
Encabezado = "<?xml"
Encabezado1 = "version=""1.0"""
Encabezado2 = "encoding=""iso-8859-1""?><cfdi:Comprobante"
aDatos(0) = Encabezado
aDatos(1) = Encabezado1
aDatos(2) = Encabezado2
' volvemos a abrir el txt para escritura (sobreescribe al anterior)
Open sRuta For Output As #1
For i = LBound(aDatos) To UBound(aDatos) 'aDatos
TextDevXml = Join(aDatos)
Next i
Print #1, TextDevXml
Close #1
Resume
Application.StatusBar = False
End Sub
[/CODE]
Hola:
Respondiendo a este post:
https://www.ayudaexcel.com/foro/threads/importar-xml-a-masiva-en-excel.40952/
[/size]
ExtraerXML.ro.rar