La macro es así :
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(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "Archivos Xml", "*.xml*"
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If Not .Show Then Exit Sub
ruta = .SelectedItems(1)
diag = InStrRev(ruta, "\")
[B2] = Left(ruta, diag)
For Each ar In .SelectedItems
arch = Mid(ar, diag + 1)
Workbooks.OpenXML Filename:=ar
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) = arch
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
Next
End With
'
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
Mira dependiendo lo que quieras extraer del xml es como le vamos quitando cosas.
Si gustas pasameun ejemplo a mi correo para ver que se le va a quitar y lo hacemos.
[email protected]