Macro para buscar en varias carpetas xml's

Tengo la siguiente macro y necesito que busque en sub carpetas me podrían ayudar, funciona perfectamente en una carpeta, pero necesito que busque en subcarpetas

Sub ExtraerFolioFiscal()
Dim MiPc, carpeta, Archivos, archivo
Dim y, Fila, FolioFiscal
Application.ScreenUpdating = False
Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set carpeta = MiPc.GetFolder(Range("A1").Value)
Set Archivos = carpeta.Files
For Each archivo In Archivos
   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)) = "/@folio" Then
            FolioFiscal = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Emisor/@rfc" Then
            EmisorRfc = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Emisor/@nombre" Then
            EmisorNombre = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Receptor/@nombre" Then
            ReceptorNombre = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Receptor/@rfc" Then
            ReceptorRFC = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/@metodoDePago" Then
            metodoDePago = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/@total" Then
            Total = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/@fecha" Then
            Fecha = Cells(3, y)
         End If
         If Trim(Cells(2, y)) = "/cfdi:Conceptos/cfdi:Concepto/@descripcion" Then
            Descripcion = Cells(3, y)
         End If
         y = y + 1
      Loop
      '--
      archivo = ActiveWorkbook.Name
      ActiveWorkbook.Close
      Range("A" & Fila) = archivo
      Range("B" & Fila) = FolioFiscal
      Range("C" & Fila) = EmisorRfc
      Range("D" & Fila) = EmisorNombre
      Range("E" & Fila) = ReceptorNombre
      Range("F" & Fila) = ReceptorRFC
      Range("G" & Fila) = metodoDePago
      Range("H" & Fila) = Total
      Range("I" & Fila) = Fecha
      Range("J" & Fila) = Descripcion
      Fila = Fila + 1
   End If
Next
End Sub