YUNECK

agradezco el apoyo brindado muchas gracias @Macro Antonio y @aaquino los 2 archivos estan excelentes, una pregunta porque cuando selecciono la carpeta no se visualizan los archivo .xml se podra que cuando me abra la carpeta desde ahi seleccione varios archivos xml que deseo importar es decir que me deje seleccionar con el mouse varios archivos .xml; porque los formularios me permiten ir seleccionando uno por uno y un formulario tiene la funcion de seleccionar todos los que estan en la carpeta o se podra que el formulario me permita seleccionar arrastrando el mouse. Nuevamente gracias por su apoyo.

Les comento que he estado buscado la forma de hacer funcionar la macro, ya me deja seleccionar la carpeta donde se encuentran los archivos (.xml) que quiero importar, el detalle es que solo me deja seleccionar un archivo pero me copia todos los que se encuentren en esa carpeta, necesito del apoyo de ustedes para que me deje seleccionar los archivos que quiero copiar y solo copie los que seleccione, es decir que si en la carpeta se encuentran 10 archivos .xml solo me copie los que yo seleccione 5-4-8-9 ojala pero pudieran ayudar, anexo archivo de la macro y archivos XML MACRO XML 3.xlsm 1FF9B0F9-DFE5-4253-AD41-2152792DC581.xml 2D0EB271-2A1F-49EC-8C3F-7D85E885829D.xml 5C908839-1F11-4BE2-B626-614AF0E61E6E.xml 8BE5E154-55B2-4C63-ADE7-548B4BF598BC.xml 8E06A072-A4D8-4B73-9719-7967C99B5310.xml 9C09106C-470F-4677-9EA6-10225BE25588.xml

QUE TAL AMIGOS HE INTENTADO HECHAR ANDAR LA MACRO PERO NO HE TENIDO SUERTE, YA CAMBIE LA LINEA: Set Carpeta = MiPc.GetFolder(Range("B1").Value) Y PUSE Set Carpeta= Application.GetOpenFilename("Archivos XML (*.xml), *.xml", MultiSelect:=True) si me dejo seleccionar varios archivos de la carpeta que yo seleccione , pero cuando le doy abrir no me pega ningun dato de los archivos XML. Anexo archivo para ver si ustedes me pueden apoyar. MACRO XML 3.xlsm 2DF7384D-2FB7-4A15-A88C-659C321749C8.xml 6A2AB631-C949-49C3-8131-271CC23C0174.xml 8A52121D-B2FD-4F4F-AA17-9F42BEC11CA3.xml 8B293B96-2CC0-4BBD-8F1B-5FCBD0392976.xml 39A2D541-2BD0-439D-9388-9878950DD156.xml

BUENAS TARDES @Macro Antonio te comento que ya probe tu macro pero el unico detalle que no me pega los datos de los documentos XML que seleccione, anexo archivo de la macro y archivos .XML el detalle de esta macro que anexo es que solo me deja seleccionar uno por uno y no puedo hacer que me seleccione varios archivos. GRACIAS POR TU APOYO Y RESPUESTA MACRO XML 3.xlsm 03C8C439-F777-41E9-8936-7905753FC031.xml 3FA902BE-99EF-4F06-9097-6A4D8E8EE33A.xml 4DB9106C-3DB4-4B3E-BAE5-C03BDED89B57.xml 6DC9E326-E6A3-4C64-BC5C-8B48B6C49138.xml 6EDB3091-6FCA-4F83-9C59-CC7667019FFB.xml 33A8A692-1956-4ED9-AF82-3CA5E77BFEE5.xml

BUENAS TARDES AMIGOS SOLICITO DE SU VALIOSO APOYO, YA QUE NECESITO QUE EN UNA MACRO ME SELECCIONE LOS ARCHIVOS(XML) QUE NECESITO IMPORTAR. ANEXO ARCHIVO, EN ESTA MACRO QUE POR CIERTO LA ENCONTRE EN ESTE FORO, LO QUE HACE ES QUE MEDIANTE LA CELDA B1 INDICAR LA RUTA DE LOS ARCHIVOS A IMPORTAR, PERO LO QUE REQUIERO QUE HAGA ESTA MACRO ES QUE ABRA UNA VENTANA PARA QUE ME DEJE SELECCIONAR LOS ARCHIVOS QUE VOY A IMPORTAR Sub ExtraerFolioFiscal() On Error Resume Next pregunta = MsgBox("Desea importar los XML´s?", vbYesNo + vbQuestion, "Soluciones MS Excel VBA") If pregunta <> vbNo Then 'Application.DisplayAlerts = True 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 Contator = 1 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)) = "/@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) ElseIf Trim(Cells(2, Y)) = "/@condicionesDePago" Then '<||||||||||||||||||||||||| condicionesDePago = Cells(3, Y) End If Y = Y + 1 Loop Contador = Contador + 1 '-- Archivo = ActiveWorkbook.Name ActiveWorkbook.Close Range("A" & Fila) = XMLVERSION Range("B" & Fila) = SERIE Range("C" & Fila) = FOLIO Range("D" & Fila) = FECHAS Range("E" & Fila) = FPAGO Range("F" & Fila) = condicionesDePago '<||||||||||||||||||||||||| Range("G" & Fila) = MPAGO Range("H" & Fila) = LEXPEDICION & "," & ESTADO Range("I" & Fila) = UUID Range("J" & Fila) = NCUENTAPAGO Range("K" & Fila) = EMISORRFC Range("L" & Fila) = ENOMBRE Range("M" & Fila) = CALLE Range("N" & Fila) = NEXTERIOR 'Range("O" & Fila) = Range("P" & Fila) = COLONIA Range("Q" & Fila) = LEXPEDICION Range("R" & Fila) = ESTADO Range("S" & Fila) = PAIS Range("T" & Fila) = CODIGOPOSTAL Range("U" & Fila) = RFISCAL Range("V" & Fila) = RFCRECEPTOR Range("W" & Fila) = RECEPTORN Range("X" & Fila) = CALLERECEP Range("Y" & Fila) = RECEPNOEXT 'Range("Z" & Fila) = Range("AA" & Fila) = RECEPCOLONIA Range("AB" & Fila) = RECEPMUNICIPIO Range("AC" & Fila) = RECEPESTADO Range("AD" & Fila) = RECEPPAIS Range("AE" & Fila) = RECEPCPOSTAL Range("AF" & Fila) = Subtotal Range("AG" & Fila) = TASA Range("AH" & Fila) = Total Range("AI" & Fila) = MONEDA Hoja1.Hyperlinks.Add Anchor:=Range("AJ" & Fila), Address:=Carpeta & "\" & Archivo, TextToDisplay:=Carpeta & "\" & Archivo Fila = Fila + 1 End If Application.StatusBar = "Progreso: " & Contador & _ " de " & cuenta & " (" & Format(Contador / cuenta, "Percent") & ")" Next Application.StatusBar = False 'Alerta MsgBox "XML´s generado (s)", vbInformation, "XML´s..." End If End Sub

BUENAS TARDES, HACE UNOS MESES APROXIMADAMENTE EN MAYO UN COLEGA DE ESTE FORO DIO SOLUCIÓN A UN COMPAÑERO, DONDE ATRAVES DE UNA MACRO IMPORTABA DE UNA CARPETA UN XML SELECCIONADO, LO PROBE Y FUNCIONA PERFECTO LE HE AUMENTADO COLUMNAS, Y UNA COLUMNA MUY IMPORTANTE DEL XML ES EL CONCEPTO SE LO AGREGUE PERO NECESITO QUE ME SALGA TODOS LOS CONCEPTO QUE CONTIENE EL XML DEJO EN ARCHIVO ADJUNTO UN EJEMPLO EN EXCEL DE COMO ME SALE Y COMO NECESITO QUE SALGA ADJUNTO ARCHIVO XML, TAMBIEN NECESITO DE SU APOYO PARA QUE ME DEJE SELECCIONAR DE UNA CARPETA VARIOS O TODOS LOS ARCHIVOS XML, AGRADEZCO SU APOYO, LA MACRO QUE ESTOY UTILIZANDO ES LA SIGUIENTE: Sub ExtraerFolioFiscal() On Error Resume Next 'Application.DisplayAlerts = True Dim Archivo Dim y, Fila, FolioFiscal Application.ScreenUpdating = False Fila = Range("A" & Rows.Count).End(xlUp).Row + 1 Archivo = Application.GetOpenFilename("Archivos xml (*.xml), *.xml") If Archivo = False Then Exit Sub Workbooks.OpenXML Filename:=Archivo y = 1: FolioFiscal = "" Do Until Trim(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)) = "/cfdi:Conceptos/cfdi:Concepto/@descripcion" Then Concepto = 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)) = "/@descuento" Then descuento = Cells(3, y) ElseIf Trim(Cells(2, y)) = "/cfdi:Impuestos/@totalImpuestosTrasladados" Then IMPUESTO = Cells(3, y) ElseIf Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Traslados/cfdi:Traslado/@importe" Then IVA = Cells(3, y) ElseIf Trim(Cells(2, y)) = "/cfdi:Impuestos/cfdi:Traslados/cfdi:Traslado/@tasa" Then TASA = Cells(3, y) ElseIf Trim(Cells(2, y)) = "/@condicionesDePago" Then '<||||||||||||| condicionesDePago = Cells(3, y) End If y = y + 1 Loop '-- ActiveWorkbook.Close 'Archivo xml '-- Range("A" & Fila) = XMLVERSION Range("B" & Fila) = SERIE Range("C" & Fila) = FOLIO Range("D" & Fila) = FECHAS Range("E" & Fila) = FPAGO Range("F" & Fila) = condicionesDePago '<||||||||||||| Range("G" & Fila) = MPAGO Range("H" & Fila) = LEXPEDICION & "," & ESTADO Range("I" & Fila) = UUID Range("J" & Fila) = NCUENTAPAGO Range("K" & Fila) = EMISORRFC Range("L" & Fila) = ENOMBRE Range("M" & Fila) = CALLE Range("N" & Fila) = NEXTERIOR 'Range("O" & Fila) = Range("P" & Fila) = COLONIA Range("Q" & Fila) = LEXPEDICION Range("R" & Fila) = ESTADO Range("S" & Fila) = PAIS Range("T" & Fila) = CODIGOPOSTAL Range("U" & Fila) = RFISCAL Range("V" & Fila) = RFCRECEPTOR Range("W" & Fila) = RECEPTORN Range("X" & Fila) = CALLERECEP Range("Y" & Fila) = RECEPNOEXT 'Range("Z" & Fila) = Range("AA" & Fila) = RECEPCOLONIA Range("AB" & Fila) = RECEPMUNICIPIO Range("AC" & Fila) = RECEPESTADO Range("AD" & Fila) = RECEPPAIS Range("AE" & Fila) = RECEPCPOSTAL Range("AF" & Fila) = Concepto Range("AG" & Fila) = Subtotal Range("AH" & Fila) = descuento Range("AI" & Fila) = TASA Range("AJ" & Fila) = IMPUESTO Range("AK" & Fila) = IVA Range("AL" & Fila) = Total Range("AM" & Fila) = MONEDA Hoja1.Hyperlinks.Add Anchor:=Range("AN" & Fila), _ Address:=Carpeta & "\" & Archivo, _ TextToDisplay:=Archivo End Sub EJEMPLO.xlsm