Lister un dossier

5 mars 2014
Imprimer
Sub ListDos()
'déclaration des variables de type string (chaîne de caractères)
Dim strChem As String, strTemp As String
'déclaration des variables de type Integer (entier)
Dim iLigne As Integer, iCol As Integer
'efface la liste déjà existante, le code se trouve ci-dessous
EffacExist 'dans votre classeur il vous faut nommer une cellule "rChem" 'et y mettre l'adresse du dossier à lister 'récupération du dossier à lister dans la cellule "rChem",
strChem = Range("rChem")
'Pour faire une recherche dans un dossier il est impératif que le chemin finisse par un \
'En conséquence on vérifie sa présence en fin de chemin
's'il n'y est pas on l'ajoute
If Right(strChem, 1) <> "\" Then strChem = strChem & "\"
'iLigne représente le N° de la ligne de la cellule "rChem"
iLigne = Range("rChem").Row
'iCol représente le N° de la colonne de la cellule situé à droite de "rChem"
iCol = Range("rChem").Column + 1
'Dir renvoie dans strTemp le nom du 1er dossier(vbDirectory) de strChem
strTemp = Dir(strChem, vbDirectory)
'on fait les instructions entre do et loop jusqu'à ce que strTemp soit vide
's'il est vide c'est qu'il ne contient plus d'autre dossier
Do Until strTemp = ""
'ignore le dossier courant et le dossier parent
'en effet dir renvoie tous les dossiers comme dans le DOS
If strTemp <> "." And strTemp <> ".." Then
'incrémentation de la ligne pour écrire en dessous
iLigne = iLigne + 1
'la méthode cells renvoie une cellule à partir d'un N° de ligne et d'un N° de colonne
Cells(iLigne, iCol) = strTemp
End If
'recherche du dossier suivant
strTemp = Dir
Loop End Sub
Sub EffacExist()
'déclaration des variables de type Integer (entier)
Dim iLigneDeb As Integer, iLigneFin As Integer, iCol As Integer 'iCol représente le N° de la colonne de la liste des dossiers
iCol = Range("rChem").Column + 1
'iLigneDeb représente le N° de de la cellule "rChem"
iLigneDeb = Range("rChem").Row
'si la 1ère cellule est vide c'est inutile d'aller plus loin
If Cells(iLigneDeb + 1, iCol) = "" Then Exit Sub
'iLigneFin représente le N° de la derniere ligne de la liste des dossiers
iLigneFin = Cells(iLigneDeb + 1, iCol).End(xlDown).Row
'on efface maintenant le contenu de la liste des dossiers
'range(cells(noligne,nocolonne),cells(noligne2,nocolonne2)) représente une plage allant du 1er cells au second cells
'ClearContents permet de n'effacer que le contenu sans modifier le format
Range(Cells(iLigneDeb + 1, iCol), Cells(iLigneFin, iCol)).ClearContents End Sub