Récuperer des fichiers dans des sous répertoi

Bonjour,

Quelques précisions :

1.) Dans ces sous répertoires, y a-t-il plusieurs type de fichiers ( *.xls, *.doc, *.jpg, *.mp3 ... ) ?

2.) Y a-t-il d'autres sous-répertoires à celuici : G:\Souscription Plaisance\Corbeille courrier\ que les 4 mentionnés ?

3.) La macro se lance comment, par un bouton, un menu, à l'ouverture ?

Lupin

re:

en supposant qu'il n'y ait que des fichiers Excels a exploiter,
en supposant qu'il n'y ait pas d'autres sous-dossiers,
en supossant que l'on appelle la macro par le menu.

la liste est produite sur la feuille active, du classeur actif !

Option Explicit

Const Dossier1 = "G:\Souscription Plaisance\Corbeille courrier\Affaires Nouvelles à établir\"
Const Dossier2 = "G:\Souscription Plaisance\Corbeille courrier\Courrier à traiter\"
Const Dossier3 = "G:\Souscription Plaisance\Corbeille courrier\Résil à traiter\"
Const Dossier4 = "G:\Souscription Plaisance\Corbeille courrier\Tarification & Notes de Couverture\"

Const cteExcel = ".xls"
'

Sub TraitementDossier()

    Call ParcoursDossier(Dossier1)
    Call ParcoursDossier(Dossier2)
    Call ParcoursDossier(Dossier3)
    Call ParcoursDossier(Dossier4)

End Sub
'

Function ParcoursDossier(Repertoire As String)
    
    Dim varFichier As Variant, ListeFichiers As String
    Dim Boucle As Long
    
    ListeFichiers = "": Boucle = 0
    Range("A2").Select
    varFichier = Dir(Repertoire & "*" & cteExcel, vbDirectory)
    Do While varFichier <> ""
        If ((varFichier <> ".") And (varFichier <> "..")) Then
            If Not ((GetAttr(Repertoire & varFichier) And vbDirectory) = vbDirectory) Then
                ActiveCell.Value = Repertoire & varFichier
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                    Repertoire & varFichier, TextToDisplay:=Repertoire & varFichier
                Boucle = (Boucle + 1)
                ActiveCell.Offset(1, 0).Select
            End If
        End If
        varFichier = Dir
    Loop
    
End Function
'

Lupin

Merci pour ta réponse je n'ai pas encore eu le temps de tester, je penser recevoir une messgae sur mon adresse mail quand quelqu'un me répondrai mais non. c bizare.

1) oui il y a plusieur type de fichier et j'aimerai tous les récuperers. .doc .xls. psf .msg ...

2) oui il y a un sous répertoire de plus qui s'appelle G:\Souscription Plaisance\Corbeille courrier\Archivage. mais je n'est pas besoin d'allé récuperer les fichier dedans.

3) J'aimerai que le mise a jour ce fasse lors de l'ouverture du fichier, mais quelle soit aussi possible de mettre a jour quand le fichier est ouvert a l'aide d'un bouton ou autre chose.

je te remerci énormément pour le temps que tu passe pour me répondre. Je crois que je vais me mettre au langage vba car ça me passionne et c super utile, aurais tu un ou vrage a me conseiller. merci

En fait c bon j'ai modifier Const cteExcel = ".xls" en Const cteExcel = "*." et ça fonctionne. j'arrive a récuperer tout les fichier mais le problème c que quand je fait ça, il ne va plus récupérer les fichier dans Affaire nouvelle à ètablir alors que je n'ai rien modifier. Et quand je remet Const cteExcel = ".xls" et bien il va chercher les fichier dans affaire nouvelle à ètablir.

voila le code
Option Explicit

Const Dossier1 = "G:\Souscription Plaisance\Corbeille courrier\Affaires Nouvelles à établir\"
Const Dossier2 = "G:\Souscription Plaisance\Corbeille courrier\Courrier à traiter\"
Const Dossier3 = "G:\Souscription Plaisance\Corbeille courrier\Résil à traiter\"
Const Dossier4 = "G:\Souscription Plaisance\Corbeille courrier\Tarification & Notes de Couverture\"

Const cteExcel = "*."
'

Sub TraitementDossier()

Call ParcoursDossier(Dossier1)
Call ParcoursDossier(Dossier2)
Call ParcoursDossier(Dossier3)
Call ParcoursDossier(Dossier4)

End Sub
'

Function ParcoursDossier(Repertoire As String)

Dim varFichier As Variant, ListeFichiers As String
Dim Boucle As Long

ListeFichiers = "": Boucle = 0
Range("A2").Select
varFichier = Dir(Repertoire & "*" & cteExcel, vbDirectory)
Do While varFichier <> ""
If ((varFichier <> ".") And (varFichier <> "..")) Then
If Not ((GetAttr(Repertoire & varFichier) And vbDirectory) = vbDirectory) Then
ActiveCell.Value = Repertoire & varFichier
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Repertoire & varFichier, TextToDisplay:=Repertoire & varFichier
Boucle = (Boucle + 1)
ActiveCell.Offset(1, 0).Select
End If
End If
varFichier = Dir
Loop

End Function

Bonjour,

Tu peux modifier la ligne :

Const cteExcel = "*.xls"

pour

Const cteFichier = "*.*"

ainsi tu auras tous les fichiers.

Pour le démarrage de la macro à l'ouverture :

1. Ouvrir le fichier
2. Taper Alt F11
3. Localisé le nom du fichier dans fenêtre de gauche
4. Localisé ThisWorkbook sous le fichier (double clic)
5. Fenêtre de droite, liste déroulante de gauche, choisir [ Workbook ]
6. Ajouter l'instruction : [ Call TraitementDossier ] dans la routine [ Workbook_Open ].

Lupin

re :

Comme ouvrage de référence, j'utilise :
--------------------------------------------------------------------
Excel 2000 et VBA Le guide du développeur
John Walkenbach
--------------------------------------------------------------------
Beginning Access 97 VBA Programming
Robert Smith and David Sussman
--------------------------------------------------------------------

Lupin