Modificar macro para poder aplicar "Application.GetOpenFilename"en esta macro.

H o l a:

Te anexo la macro actualizada, para seleccionar la carpeta y con el cambio de elseif por la estructura Case:

Sub ExtraerFolioFiscal2()
'Act.Por.Dante Amor
    Dim cp, Archivos
    Dim y, Fila, FolioFiscal
    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
    Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1) & "\"
    End With
    '
    [B1] = cp
    Archivos = Dir(cp & "*.xml")
    Do While Archivos <> ""
        Workbooks.OpenXML Filename:=Archivos
        y = 1: FolioFiscal = ""
        Do Until Cells(2, y) = ""
            Select Case Trim(Cells(2, y))
            Case "/cfdi:Complemento/tfd:TimbreFiscalDigital/@UUID": FolioFiscal = Cells(3, y)
            Case "/@serie":                                         SERIE = Cells(3, y)
            Case "/@folio":                                         FOLIO = Cells(3, y)
            Case "/cfdi:Receptor/@rfc":                             RECEPTORRFC = Cells(3, y)
            Case "/cfdi:Receptor/@nombre":                          RECEPTORNOMBRE = Cells(3, y)
            Case "/cfdi:Emisor/@rfc":                               EMISORRFC = Cells(3, y)
            Case "/cfdi:Emisor/@nombre":                            EMISORNOMBRE = Cells(3, y)
            Case "/@Moneda":                                        MONEDA = Cells(3, y)
            Case "/@TipoCambio":                                    TIPOCAMBIO = Cells(3, y)
            Case "/@subTotal":                                      Subtotal = Cells(3, y)
            Case "/cfdi:Impuestos/@totalImpuestosRetenidos":        TOTALIMPUESTOSRETENIDOS = Cells(3, y)
            Case "/cfdi:Impuestos/@totalImpuestosTrasladados":      TOTALIMPUESTOSTRASLADADOS = Cells(3, y)
            Case "/@total":                                         Total = Cells(3, y)
            Case "/cfdi:Conceptos/cfdi:Concepto/@descripcion":      CONCEPTO = Cells(3, y)
            Case "/@fecha":                                         FECHA = Cells(3, y)
            Case "/@LugarExpedicion":                               LugarExpedicion = Cells(3, y)
            Case "/@tipoDeComprobante":                             TIPODECOMPROBANTE = Cells(3, y)
            End Select
            y = y + 1
        Loop
        '--
        ActiveWorkbook.Close
        Range("A" & Fila) = Archivos
        Range("B" & Fila) = FolioFiscal
        Range("C" & Fila) = SERIE
        Range("D" & Fila) = FOLIO
        Range("E" & Fila) = RECEPTORRFC
        Range("F" & Fila) = RECEPTORNOMBRE
        Range("G" & Fila) = EMISORRFC
        Range("H" & Fila) = EMISORNOMBRE
        Range("I" & Fila) = MONEDA
        Range("J" & Fila) = TIPOCAMBIO
        Range("K" & Fila) = Subtotal
        Range("L" & Fila) = TOTALIMPUESTOSRETENIDOS
        Range("M" & Fila) = TOTALIMPUESTOSTRASLADADOS
        Range("N" & Fila) = Total
        Range("O" & Fila) = CONCEPTO
        Range("P" & Fila) = FECHA
        Range("Q" & Fila) = LugarExpedicion
        Range("R" & Fila) = TIPODECOMPROBANTE
        Fila = Fila + 1
        Archivos = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

‘

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

disculpa sr dante me sale un error en la palabra (Workbooks.OpenXML Filename:=Archivos) y me dice que no encuentra mi archivo xml (ejemplo)

Me estará haciendo falta algo amigo, ¿en el macro?

En la celda B1 te puso la carpeta, ¿dime qué te puso en la celda B1?

Me puso la dirección donde tengo los xml dante, pero, no paso a lo más importante de la macro que es la extracción de los archivos amigo, solamente me dice que no se encuentra el xml, y es el primer archivo que esta adentro de la carpeta amigo, gracias por su pronta respuesta amigo

¿Puedes copiar lo que te puso en la celda B1 y mostrar exactamente qué te puso?

C:\Users\pc\Desktop\okey\dca-abril y mayo\mayo\28\

Después de esta línea:

Do While Archivos <> ""

Agrega esta línea a la macro

msgbox cp & Archivos

Y me dices exactamente qué te aparece

Me sale 1ero esto y un botón de aceptar, lo oprimo y me sale después lo de abajo en visual basic de excel.

C:\Users\pc\Desktop\okey\dca-abril y mayo\mayo\28\0AB22643-6420-446C-93CB-B7DDE54794B7.xml

-------------------------------------------------------------------------------------------------------------

(Lo sentimos no hemos encontrado 0AB22643-6420-446C-93CB-B7DDE54794B7.xml ¿puede qué lo hayas movido, eliminado o lehayas cambiado el nombre?

Disculpa dante creo que el problema esta en la selección de los archivos ya que cambie en mi archivo original el if que tenia por el select case que me propusiste y si extrae la información del xml como el archivo original que tenia, simplemente lo que faltaría, seria para seleccionar los archivos de xml y te aparecieran cuales quieres elegir, ya esta la dirección de la carpeta de donde están todos los xml en la casilla b2 pero me faltaría la función para elegir cuales xml de la carpeta elegir para poder cuales si y cuales no, gracias por su atención prestada amigo.

Primero, tienes que utilizar toda la macro que yo te envíe, es decir, reemplazar tu macro por la macro que te envié.

Segundo, lo que pediste fue esto:

"para poder abrir y buscar desde el buscador de archivos, en lugar de tener que ponerle toda la dieccion en una celda, quisiera que se copiara la direccion en la celda pero cuando ya la haya buscado en el buscador de archivos".

Tu macro leía la carpeta desde una celda, lo que entiendo que quieres es que ya no se lea la carpeta de la celda y puedas elegir una carpeta.

La macro que te entregué hace justamente eso, te permite seleccionar una carpeta.

Además cambié los If por la estructura Select Case.

Ahora, estás pidiendo esto:

"seria para seleccionar los archivos de xml y te aparecieran cuales quieres elegir"

Con mucho gusto te ayudo con todas tus peticiones.

Valora esta respuesta y crea una nueva pregunta en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor"

Sal u dos

¡Gracias! Dante por las soluciones y creo que me exprese mal en la petición