Jump to content
YUNECK

SELECCIONAR VARIOS ARCHIVOS A IMPORTAR

Recommended Posts

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

Share this post


Link to post
Share on other sites

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

Edited by YUNECK
DATOS

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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.

Share this post


Link to post
Share on other sites
En 3/2/2017 at 14:44 , Antoni dijo:

Hay 3 botones en el margen inferior izquierdo que te permiten seleccionar todos los archivo, invertir la selección o borrar la selección, no obstante, te he hecho una modificación para que puedas arrastrar y/o seleccionar con la tecla control.

Extraer folio fiscal II (1).xlsm

Buen dia estimado Antoni me podrias ayudar con un archivo modificado en el cual se pueda extraer del xml los siguientes datos:
 

<numeroAutorizacion>

<razonSocial>

<ruc>

<estab>

<ptoEmi>

<secuencial>

<fechaEmision>

<razonSocialComprador>

<identificacionComprador>

 <baseImponible>

<tarifa>

<valor>

<propina>

<importeTotal>

<total>

DOCUENTO.xml

Factura.xml

 

muchas gracias

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png