Tester l'existence de répertoires à partir d'une liste
Résolu/Fermé
Wyrgle
Messages postés
4
Date d'inscription
samedi 8 août 2015
Statut
Membre
Dernière intervention
23 juin 2016
-
15 juin 2016 à 23:37
Wyrgle Messages postés 4 Date d'inscription samedi 8 août 2015 Statut Membre Dernière intervention 23 juin 2016 - 16 juin 2016 à 21:12
Wyrgle Messages postés 4 Date d'inscription samedi 8 août 2015 Statut Membre Dernière intervention 23 juin 2016 - 16 juin 2016 à 21:12
A voir également:
- Tester l'existence de répertoires à partir d'une liste
- Liste déroulante excel - Guide
- Annuaire portable gratuit a partir d'un nom ✓ - Forum Mobile
- Comment trouver un numéro à partir du nom et prénom ✓ - Forum Mobile
- Liste de numéro de téléphone suspect 07 ✓ - Forum Mobile
- Trouver un numero de portable a partir d'un nom svp - Forum Internet / Réseaux sociaux
3 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
16 juin 2016 à 07:38
16 juin 2016 à 07:38
Bonjour
Pourquoi colores tu tes cellules colonne E en rouge? .
Pour les repérer et ainsi créer les répertoires manquants?
Pourquoi colores tu tes cellules colonne E en rouge? .
Pour les repérer et ainsi créer les répertoires manquants?
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
16 juin 2016 à 15:11
16 juin 2016 à 15:11
Re-
Ton erreur est ici :
Dans tous les cas, il te faut changer de ligne et passer à la cellule suivante, que ton répertoire existe ou non. Donc l'incrémentation de la ligne et du chemin doivent être sortis du test If - End If.
La procédure que je te propose va créer les répertoires (et leurs sous-répertoires), s'ils ne sont pas déjà existants et que les noms contenus dans les cellules sont valides.
N'hésite pas à poser toutes questions complémentaires.
Ton erreur est ici :
ligne = ligne + 1 ' je passe à la ligne suivante
Chemin = Cells(ligne, 4).Text ' j'actualise le répertoire suivant à tester
End If
Dans tous les cas, il te faut changer de ligne et passer à la cellule suivante, que ton répertoire existe ou non. Donc l'incrémentation de la ligne et du chemin doivent être sortis du test If - End If.
La procédure que je te propose va créer les répertoires (et leurs sous-répertoires), s'ils ne sont pas déjà existants et que les noms contenus dans les cellules sont valides.
N'hésite pas à poser toutes questions complémentaires.
Option Explicit
Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
Sub Existence_of_Directory()
Dim ligne As Integer, Chemin As String, Msg As String, NomsRep As Variant, i As Integer, monBool As Boolean
Msg = "Impossible de créer le(s) répertoire(s) suivant(s) :"
' 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
'trouve les noms des sous-sous-...-sous répertoires à créer
NomsRep = Split(Chemin, "\")
'évite une erreur si le contenu de la cellule se termine par "\"
If Right(Chemin, 1) = "\" Then ReDim Preserve NomsRep(UBound(NomsRep) - 1)
monBool = True
For i = LBound(NomsRep) + 1 To UBound(NomsRep)
If Nom_Valide(NomsRep(i)) = False Then ' Si un des noms choisis dans le chemin complet n'est pas valide
monBool = False
Exit For
End If
Next i
If monBool Then
SHCreateDirectoryEx 0, Chemin, ByVal 0&
Else
Msg = Msg & vbCrLf & Chemin
End If
ligne = ligne + 1 ' je passe à la ligne suivante
Chemin = Cells(ligne, 4).Text ' j'actualise le répertoire suivant à tester
Loop
If Msg <> "Impossible de créer le(s) répertoire(s) suivant(s) :" Then MsgBox Msg
End Sub
Private Function Nom_Valide(ByVal Repertoire As String) As Boolean
Dim i As Long, Test As Variant
Const CARS_INVALIDES As String = """,/,\,:,|,<,>,*,?"
Const MOTS_INVALIDES As String = "con,prn,aux,clock$,nul,com1,com2,com3,com4,com5,com6,com7,com8,com9,lpt1,lpt2,lpt3,lpt4,lpt5,lpt6,lpt7,lpt8,lpt9"
'valeur par défaut
Nom_Valide = False
'si le nom du répertoire est vide ou qu'il se termine par " " ou "." Alors ==> FAUTE
If Len(Trim$(Repertoire)) = 0 Or Right$(Repertoire, 1) = " " Or Right$(Repertoire, 1) = "." Then Exit Function
'si le nom du répertoire contient un caractère interdit Alors ==> FAUTE
Test = Split(CARS_INVALIDES, ",")
For i = LBound(Test) To UBound(Test)
If InStr(1, Repertoire, Test(i)) > 0 Then Exit Function
Next
'si le nom du répertoire est un mot interdit Alors ==> FAUTE
Test = Split(MOTS_INVALIDES, ",")
For i = LBound(Test) To UBound(Test)
If LCase$(Repertoire) = Test(i) Then Exit Function
Next
'sinon c'est bon
Nom_Valide = True
End Function
Wyrgle
Messages postés
4
Date d'inscription
samedi 8 août 2015
Statut
Membre
Dernière intervention
23 juin 2016
Modifié par Wyrgle le 16/06/2016 à 21:12
Modifié par Wyrgle le 16/06/2016 à 21:12
Merci pour ta réponse Pijaku, ton code est super, je me le garde. En fait j'ai trouvé mon erreur cet après-midi :
Résolu !
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
Résolu !