VBA 200 fichiers Recuperer un element du titre du fichier dans une colonne

[anthooooony]

Bonjour à tous,

Je cherche à automatiser un travail

j'ai 200 fichiers xls, que j’intègre dans Access. Il y a t-il un moyen de faire rajouter à chaque ligne de chaque fichier les deux derniers chiffres du nom_du_fichier?

Mes fichiers sont dans un seul dossier, le nom de chaque fichier est "Extraction_S**"
Extraction_S34
CocaCola_S34
Pepsi_S34
Fanta_S34

Il y a t-il un moyen de lui faire rajouter une colonne(4ème) avec le numéro de semaine qui est à la fin du titre du fichier.

Je ne sais pas s'il est plus simple de faire un macro par Excel, ou le faire directement par Access.

Mon besoin initial était de récupérer tout les fichiers d'un dossier et l’intégrer dans une table Access ce que j'ai réussi à trouver grâce au forum Excel Download.

Sub tranfertFeuilleClasseursFermes_VersAccess_V02()
'Nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library
'Nécessite d'activer la référence Microsoft ADO ext x.x for DLL and Security
'
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String, Feuille As String
Dim oCat As ADOX.Catalog
 
'------------------------------------------------------
'Connection à la Base Access
Set oConn = New ADODB.Connection
oConn.Open "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source= 'C:\Documents and Settings\RC1194\Desktop\Test appli\maBase.mdb';"
 
'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Table1", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Documents and Settings\RC1194\Desktop\Test appli\sauvegarde\"
Fichier = Dir(Repertoire & "\*.xls")
 
Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""
 
 
    '-------------------------
    Set oCat = New ADOX.Catalog
    Set oCat.ActiveConnection = Cn
    'Récupére le nom de la Feuille:
       'Attention: l'index correspond à un ordre alphabétique croissant
       'et les plages de cellules nommées sont intégrées.
    Feuille = oCat.Tables(0).Name
    '-------------------------
 
 
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [" & Feuille & "]", Cn, adOpenStatic
 
    ' --- Transfert les données dans la base ---
    Do While Not (oProdRS.EOF)
        oRS.addNew
           For j = 0 To oRS.Fields.Count - 1
            oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
        oRS.Update
        oProdRS.moveNext
    Loop
    '-------------------------------------------
 
 
    Set oCat = Nothing
    oProdRS.Close
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop
 
'oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

Merci beaucoup de votre aide

Anthooooony