liste variable de fichiers

[tvi]

bonjour,
Une personne de plus nulle en VBA...
pour faire simple, j'ai trouvé sur ce forum une méthode pour lister tous les fichiers d'un répertoire fixe.
la liste se compose de 2 colonnes : lien hypertexte vers fichier et date de création du fichier
Je copie cette liste 1 dans une liste 2
Ensuite des données sont ajoutées manuellement a chaque entrée de la liste 2 (colonnes supplémentaires).

Mon problème est que dans le répertoire de base, les fichiers s'ajoutent aléatoirement : soit par reclassement alphabétique, soit par reclassement en fonction de la date de création des fichiers.

AU final chaque fois que j'écrase ma liste 2 après mise a jour de ma liste 1, les données ajoutées manuellement ne sont plus en face des mêmes "entrées".

Je dois donc comparer manuellement les 2 listes et ajouter chaque nouvelle entrée une par une en fin de liste (environ 4O fois / jour !!!)

J'aimerais donc :
1) pouvoir ajouter automatiquement à la liste 2 les nouvelles entrées (peut être en comparant les 2 listes ???) à chaque ouverture de mon classeur excel.
2) pouvoir limiter ma requête VBA (qui sert a créer la liste 1) entre date du jour -1 et date du jour (car le répertoire de base contiendra environ 3000 fichiers en fin d'année)

un fichier très simple pour exemple en pièce jointe

merci d'avance pour ce gros sujet !

 

[tvi]

Re : liste variable de fichiers

OK j'ai pas mal avancé sur le sujet.
Je créer ma liste 1, je la filtre, et j'ajoute les nouvelles entrées à ma liste 2.
Donc tout irait bien si la premiere colonne de la liste 1 n'était pas en réalité des liens hypertextes.
J'arrive donc à copier le "TextToDisplay:=Fichier.Name" mais je n'arrive pas à copier le " Hyperlinks.Add Anchor:=.Cells(L, 1), Address:=Chemin & Fichier.Name, _"

 

[MJ13]

Re : liste variable de fichiers

Bonjour Tvi

Quelle est ta version d'Excel?

Bon OK XL2010 😱.

Pourrais-tu donner le code pour avoir la liste des fichiers ?

 

[tvi]

Re : liste variable de fichiers

voici le code complet (merci les auteurs de ce forum):

Sub AffichTest()
Sheets("Test").Activate
End Sub

Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long
Chemin = CheminUser
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Test").Range("A2:B65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("Test").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
L = L + 1
'MAJ feuille résultats
With ThisWorkbook.Sheets("Test")
.Cells(L, 1).Value = Chemin
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.Type
.Cells(L, 4).Value = Fichier.Size
.Cells(L, 5).Value = Fichier.DateCreated
End With
End If
End If
Next
Next D
Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
End Sub

Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, D As Object
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'examen du dossier courant
For Each D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.Path
Next
'Traitement récursif des sous-dossiers (d'après un code de F.Sigonneau)
For Each SD In Dossier.subfolders
lstDossiers SD.Path
Next SD
lstDossiers = TabTemp()
Set Dossier = Nothing
End Function

Function CheminUser() As String
Dim objShell As Object, objFolder As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Sélectionnez dans l'arborescence :", 513, 0)
If objFolder Is Nothing Then Exit Function
On Error Resume Next
Chemin = objFolder.Items.Item.Path & "\"
On Error GoTo 0
If Left(Chemin, 1) = ":" Then Chemin = ""
CheminUser = Chemin
End Function