Comparer les noms de fichiers dans un dossier avec ceux dans une feuille ex
Bonjour à tous,
je cherche à comparer les noms de fichiers excel se trouvant dans un dossier avec des noms récupérés dans un fichier
Dis comme ça, pas sur d'être compris.
Mon code vba actuel :
Sub RequeteClasseurFerme()
Dim Cn As ADODB.Connection
Dim Dossier As String, Fichier As String, texte_SQL As String
Dim Rst As ADODB.Recordset
Dim wb As Workbook
'Définit le classeur fermé servant de base de données
Dossier = "Y:\Mes documents\00 - bureau\semaine\"
Fichier = Dir(Dossier & "*.xlsx")
Set Cn = New ADODB.Connection
Set wb = ThisWorkbook
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'-----------------
Do While Len(Fichier) > 0
'je récupère le nom du fichier
wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier
'On sélectionne l'ensemble du tableau EXPORT_NORMAL
texte_SQL = "SELECT * FROM EXPORT_NORMAL"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat
wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst
Fichier = Dir
Loop
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
MsgBox "C'est terminé !"
End Sub
Donc, je vais récupérer un tableau dans chaque fichier excel qui se trouve dans le dossier Y:\Mes documents\00 - bureau\semaine\
Par la même occasion, je récupère le nom du fichier et je colle tout ça sur ma Feuil1.
Dans ce dossier, il y a régulièrement de nouveaux fichiers excel qui apparaissent.
Ma question : comment faire pour récupérer les données des nouveaux fichiers ?
Je pensais comparer les noms (vu que je les récupère) mais je ne m'en sors absolument pas
Dans ma tête, c'est tout simple mais quand je veux le coder, je tourne en rond sans vraiment réussir.
Quelqu'un pourrait-il me dépanner SVP ?
Bonjour,
Avec FSO (File System Object) je l'ai intégré dans ton code mais absolument pas testé. Les dates concernant le fichier en cours sont inscrites en colonne A sous le nom du fichier pour le test. Tu peux les inscrire ailleurs et faire les comparaisons avant la récup des valeurs :
Sub RequeteClasseurFerme()
Dim Fso As Object
Dim F As Object
Dim Cn As ADODB.Connection
Dim Dossier As String, Fichier As String, texte_SQL As String
Dim Rst As ADODB.Recordset
Dim wb As Workbook
Dim Lig As Long
'Définit le classeur fermé servant de base de données
Dossier = "Y:\Mes documents\00 - bureau\semaine\"
Fichier = Dir(Dossier & "*.xlsx")
'$$$$$$$$$$$$$$$$$$$$$$$ ICI !
Set Fso = CreateObject("Scripting.FileSystemObject")
'$$$$$$$$$$$$$$$$$$$$$$$
Set Cn = New ADODB.Connection
Set wb = ThisWorkbook
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'-----------------
Do While Len(Fichier) > 0
'je récupère le nom du fichier
'wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier
'$$$$$$$$$$$$$$$$$$$$$$$ ICI !
With wb.Sheets(1)
Lig = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(Lig, 1).Value = Fichier 'le nom du fichier
Set F = Fso.GetFile(Dossier & Fichier)
.Cells(Lig + 1, 1).Value = F.DateCreated 'la date de création
.Cells(Lig + 2, 1).Value F.DateLastModified 'la date de dernière modification
.Cells(Lig + 3, 1).Value F.DateLastAccessed 'la date du dernier accès
End With
'$$$$$$$$$$$$$$$$$$$$$$$
'On sélectionne l'ensemble du tableau EXPORT_NORMAL
texte_SQL = "SELECT * FROM EXPORT_NORMAL"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat
wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst
Fichier = Dir
Loop
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
MsgBox "C'est terminé !"
End Sub
Sinon, un code pour te donner une piste :
Sub Recup()
Dim Fso As Object
Dim F As Object
Dim Dossier As String
Dim Fichier As Variant
Dossier = "Y:\Mes documents\00 - bureau\semaine\"
Fichier = Dir(Dossier & "*.xlsx")
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Dossier & Fichier) = True Then
Set F = Fso.GetFile(Dossier & Fichier)
Range("A1") = "Chemin"
Range("A2") = "Nom du fichier"
Range("A3") = "Date de création"
Range("A4") = "Dernière modification"
Range("A5") = "Dernier Accès"
Range("A6") = "Taille (en Kilo Octets)"
Range("A7") = "Type de fichier"
Range("B1") = Left(F.Path, InStrRev(F.Path, "\"))
Range("B2") = Dir(F.Path)
Range("B3") = F.DateCreated
Range("B4") = F.DateLastModified
Range("B5") = F.DateLastAccessed
Range("B6") = Round(F.Size / 1024, 0)
Range("B7") = F.Type
End If
End Sub
merci beaucoup pour ta réponse, je vais regarder ça dans la semaine
Je savais bien que ce que je voulais faire était tout bête mais la semaine dernière, pas moyen de m'en sortir.
Je n'ai absolument pas utilisé ce que tu m'as dit mais c'est toi qui m'a mis sur la piste
Sub RequeteClasseurFerme()
Dim Cn As ADODB.Connection
Dim Dossier As String, Fichier As String, texte_SQL As String
Dim Rst As ADODB.Recordset
Dim wb As Workbook
Dim i As Integer
Application.ScreenUpdating = False
'Définit le classeur fermé servant de base de données
Dossier = "Y:\Mes documents\00 - bureau\semaine\"
Fichier = Dir(Dossier & "*.xlsx")
Set Cn = New ADODB.Connection
Set wb = ThisWorkbook
'___init var i à 2 pour avoir cellule A2 sheet 2 en 1er.
i = 2
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Dossier & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'-----------------
Do While Len(Fichier) > 0
FichierExtrac = Sheets(2).Range("A" & i).Value
'____on compare les noms de fichier. Si déjà existant, on saute la copie pour refaire une boucle avec le fichier suivant
If Fichier = FichierExtrac Then GoTo suite
'____si les 2 ne sont pas égaux, on récupère les données du tableau et on copie le nom du fichier en sheet 2 pour future comparaison
wb.Sheets(1).Range("C60000").End(xlUp).Offset(1, -2).Value = Fichier
wb.Sheets(2).Range("A60000").End(xlUp).Offset(1, 0).Value = Fichier
'On sélectionne l'ensemble du tableau EXPORT_NORMAL
texte_SQL = "SELECT * FROM EXPORT_NORMAL"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat
wb.Sheets(1).Range("B60000").End(xlUp).Offset(0, 0).CopyFromRecordset Rst
'____Comparaison noms fichiers. Si les 2 noms sont =, on saute ici pour passer au fichier suivant et on incrémente la var i
suite:
Fichier = Dir
i = i + 1
Loop
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
MsgBox "C'est terminé !"
End Sub
Bonjour,
Bien content de t'avoir mis sur la piste !