Tester existence de répertoires d'après une liste

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

Bonjour,

Indente ton code et utilise les balises 'Code' pour que ce soit plus lisible stp.

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

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

    ' 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"
        End If
        ligne = ligne + 1    ' je passe à la ligne suivante
        Chemin = Cells(ligne, 4).Text    ' j'actualise le répertoire suivant à tester
    Loop
End Sub

Integer un peu court pour des lignes, mis Long à la place.

Il faut incrémenter la ligne que le répertoire existe ou pas..

eric

Merci Eric pour ta réponse, j'ai trouvé cet après-midi après plusieurs tentatives :

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

ligne = 6
Cells(ligne, 4).Select
Chemin = Cells(ligne, 4).Text

Do While Len(Chemin) > 0
    If Len(Dir(Chemin, vbDirectory)) = 0 Then
        Cells(ligne, 5).Interior.ColorIndex = 26
        Cells(ligne, 5) = "Not created"
    Else
        Cells(ligne, 5).Interior.ColorIndex = 34
        Cells(ligne, 5) = "Created"
    End If
    ligne = ligne + 1
    Chemin = Cells(ligne, 4).Text
Loop
End Sub

Voila c'est résolu !

Wyrgle