Importar diferents Excels en Access

Tenim un directori amb diferents carpetes. Cadascuna té un fitxer excel que es diu Libro1.xlsx.
L'objectiu es unir tots aquests excels dins una taula en Access i afegir-li, a cada registre, el nom de la carpeta en un camp concret.

Ens caldrà un fitxer txt on escriurem sols els noms de les carpetes:

El codi:


Option Compare Database
Option Explicit

Public Sub cmdExcel01_Click()
    LaMevaRuta
    Lector
End Sub

Function LaMevaRuta() As String
    LaMevaRuta = CurrentProject.Path
End Function

Public Sub Lector()
    Dim strListadoTxt, strLinea As String
    Dim longListadoTxt As Long
        longListadoTxt = FreeFile
        strListadoTxt = LaMevaRuta & "\" & "listado.txt"
    Open strListadoTxt For Input As #longListadoTxt
        While Not EOF(longListadoTxt)
            Line Input #longListadoTxt, strLinea
                Copia_excel strLinea  'Copia del interior del excel
                MacroImport              'Importació des del Excel
                UpdateTbl strLinea     'Consulta d'actualització del camp INE quan esta buit
                KillExcel                   'Mata el fitxer Excel que hem copiat anteriorment
        Wend
    Close #longListadoTxt
End Sub

Sub Copia_excel(strLinea As String)
    Dim RutaGeneralExcel, RutaProvincialExcel, Origen, Destino As String
        RutaGeneralExcel = LaMevaRuta & "\"
        RutaProvincialExcel = strLinea
        Origen = RutaGeneralExcel & RutaProvincialExcel & "\" & "Libro1.xlsx"
        Destino = LaMevaRuta & "\" & "Libro1.xlsx"
    FileCopy Origen, Destino
End Sub

Function KillExcel()
    Kill LaMevaRuta & "\Libro1.xlsx"
End Function

Function MacroImport()
    DoCmd.RunSavedImportExport "ImportLibro1"
End Function

Sub UpdateTbl(strLinea As String)
        Dim qry09 As String
        qry09 = "UPDATE tblHoja1 SET tblHoja1.INE =" & strLinea & " WHERE (((tblHoja1.INE) Is Null));"
        CurrentDb.Execute qry09 'o també podria ser    docmd.Runsql qry09
End Sub

Pots llegir el codi més còmodament -amb colorins- amb el Notepad++. Pots descarregar-ho gratuitament (es software lliure) a http://notepad-plus-plus.org/

El resultat: