XL 2010 Tester l'existence de répertoires à partir d'une liste

Wyrgle · 15 Juin 2016

Bonjour à tous,

Voici mon problème : j'ai une liste de répertoires en colonne D. Je teste l'existence de ces répertoires un par un (avant de traiter leurs fichiers éventuels dans une prochaine routine).

Ce que je cherche à avoir : si un répertoire n'existe pas, la cellule en colonne E devient rouge avec la valeur N (pour Non). Mais cette macro tourne en boucle et me plante Excel 2010 (English)

Sub Existence_of_Directory()
Dim ligne As Integer
Dim Chemin As String

' la liste des répertoire commence en cellule (6,4)
ligne = 6
Cells(ligne, 4).Select

' je récupère le contenu des cellules sous forme de chaine de char
Chemin = Cells(ligne, 4).Text

' Tant que les cellules sous la cellule (6,4) ne sont pas vides
Do While Len(Chemin) <> 0
If Len(Dir(Chemin, vbDirectory)) = 0 Then ' Si le répertoire n'existe pas alors
Cells(ligne, 5).Interior.ColorIndex = 3 ' la cellule en E est rouge
Cells(ligne, 5) = "N" ' et contient "N"
ligne = ligne + 1 ' je passe à la ligne suivante
Chemin = Cells(ligne, 4).Text ' j'actualise le répertoire suivant à tester
Cells(ligne, 4).Select ' utile ??
End If
Loop
End Sub

Il doit y avoir un problème de logique, mais je ne trouve pas.

Merci pour votre aide !
Wyrgle

Lone-wolf · 16 Juin 2016

Re : Tester l'existence de répertoires à partir d'une liste

Bonjour Wyrgle

Et en mettant Else Exit Do qu'est-ce que ça donne? Sinon, dans un nouveau classeur fait un test avec ceci:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i as Long

For i = 6 To 26
If Cells(i, 1) = "" Then
Cells(i, 2) = "N"
Cells(i, 2).Interior.Color = vbRed
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
End If
Next i
Cancel = True
End Sub

Lone-wolf · 16 Juin 2016

Re : Tester l'existence de répertoires à partir d'une liste

Re

En PJ le classeur exemple et code modifié.

XL 2010 Tester l'existence de répertoires à partir d'une liste

Wyrgle

XLDnaute Junior

Lone-wolf

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Pièces jointes

Discussions similaires