Verifier si dossier contient chaine de caractères

Signaler
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
-
cs_Le Pivert
Messages postés
6479
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 janvier 2020
-
Bonjour le forum,

Je viens vous solliciter pour un problème que je n’arrive pas a résoudre tout seul
Via une macro j’enregistre un classeur comme suit :

Dans dossier C:\Users\moi\Documents\entreprise\devis un dossier ce créer avec nom et ville du client ce qui donne :

C:\Users\moi\Documents\entreprise\devis\nom_client\ville

Dans ce dossier ce créer un dossier : devis n°19123001 monsieur client ville

L’idée serait de vérifier si le dossier C:\Users\moi\Documents\entreprise\ contient un dossier
Avec chaine de caractères 19123001

Je suis sous excel 2007
Je vous remercie par avance et vous souhaite de bonnes fêtes
yann

6 réponses

Messages postés
6479
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 janvier 2020
439
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
bonjour cs_le pivert
tjrs aussi réactif
j'ai vu cette page mais le problème le code ne gère pas les sous répertoires
cs_Le Pivert
Messages postés
6479
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 janvier 2020
439
Regarde ce que te donne l'aide F1 sur dir:

Dir, fonction, exemple
Cet exemple utilise la fonction Dir pour vérifier si certains fichiers et dossiers existent. Sur le Macintosh, "HD:" désigne le lecteur par défaut et les éléments du chemin d'accès sont séparés par deux points (:) et non par des barres obliques inversées. Les caractères de remplacement de Microsoft Windows sont considérés par le Mac comme des caractères significatifs faisant partie du nom du fichier. Vous pouvez cependant utiliser la fonction MacID pour désigner des groupes de fichiers.

Dim MyFile, MyPath, MyName
' Renvoie "WIN.INI" (sur Microsoft Windows) si ce fichier existe.
MyFile = Dir("C:\WINDOWS\WIN.INI")

' Renvoie le nom de fichier avec l'extension indiquée. Si plusieurs
' fichiers *.ini existent, le premier fichier trouvé est renvoyé.
MyFile = Dir("C:\WINDOWS\*.INI")

' Appelle de nouveau Dir sans argument pour renvoyer le
' fichier *.INI suivant dans le même dossier.
MyFile = Dir

' Renvoie le premier fichier *.TXT avec l'attribut fichier caché.
MyFile = Dir("*.TXT", vbHidden)

' Affiche les noms dans C:\ représentant des dossiers.
MyPath = "c:\" ' Définit le chemin d'accès.
MyName = Dir(MyPath, vbDirectory) ' Extrait la première entrée.
Do While MyName <> "" ' Commence la boucle.
' Ignore le dossier courant et le dossier
' contenant le dossier courant.
If MyName <> "." And MyName <> ".." Then
' Utilise une comparaison au niveau du bit pour
' vérifier que MyName est un dossier.
If (GetAttr(MyPath & MyName) _
And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Affiche l'entrée uniquement si elle
End If ' représente un dossier.
End If
MyName = Dir ' Extrait l'entrée suivante.
Loop

Tu peux donc faire une boucle sur un répertoire pour voir si ce dossier existe
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
re
pour f1 dir: rien du tout
pour ton exemple, là tu m'as perdu
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
j'ai trouvé ça
</code>Sub trouve()


Dim rep_fic As String, dat_sec As String, nom_sec As String

rep_fic = "C:\Users\moi\Documents\entreprise\devis\* *\* n°19123006 * * *"


If Dir(rep_fic, vbDirectory) = "" Then

MsgBox "Le répertoire n'existe pas"
'MkDir rep_fic
Else
MsgBox " Le répertoire existe"

End If
End Sub
</code>
mais les ** apres devis font planter il faut que j'indique
"C:\Users\moi\Documents\entreprise\devis\nom_client ville\* n°19123006 * * *"

pour que ça colle
une idéee?
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
je ferme et reformule
a bientôt
Messages postés
6479
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 janvier 2020
439
J'ai trouvé cela qui affiche toute l'arborescence du répertoire. A toi de l'adapter:

https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/

Option Explicit
'https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/
Dim ligne, f, d, racine, fs, dossier_racine
Sub arborescenceRepertoire()
  racine = "C:\Users\moi\Documents\entreprise\devis\"   ' adapter répertoire
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, niveau) = dossier.Name
Cells(ligne, niveau).Font.ColorIndex = 0
   ligne = ligne + 1
 For Each f In dossier.Files
   Cells(ligne, niveau) = f.Name
   Cells(ligne, niveau).Font.ColorIndex = 3
   ligne = ligne + 1
 Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub


yanndebretagn
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020
1
bonjour a tous et tout plein de bonne chose pour cette nouvelle année

c_pivert ton code fonctionne parfaitement

l’idée maintenant est de rechercher une chaine de caractère du type 19120202 qui ce trouve en B23,
si la macro trouve 19120202 elle ajoute 1 à B23 soit 19120203 et ainsi de suite jusqu'à le numéro ne soit pas attribué
le problème c’est que suis obligé de relancer la macro entre chaque recherche
(c’est la première fois que je fais une boucle)

Merci de vos lumières
Mon code
Sub RECHERCHE()
Dim rngTrouve As Range
Dim strChaine As String, firstAddress As String
Dim n As Long
n = 1


strChaine = "*" & Sheets("renseignement client").Range("B23").Value & "*"
Set rngTrouve = Sheets("Feuil1").Columns(3).Cells.Find(strChaine, , xlValues, xlWhole)
If Not rngTrouve Is Nothing Then
firstAddress = rngTrouve.Address
Do
MsgBox "Trouvé dans la cellule " & rngTrouve.Address(0, 0) & " !"


Sheets("renseignement client").Range("D23").Value = Sheets("renseignement client").Range("D23").Value + 1

Loop While rngTrouve Is Nothing And rngTrouve.Address <> firstAddress


Else
MsgBox "Pas trouvé"
End If
End Sub
cs_Le Pivert
Messages postés
6479
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 janvier 2020
439 > yanndebretagn
Messages postés
97
Date d'inscription
dimanche 28 mai 2017
Statut
Membre
Dernière intervention
6 janvier 2020

Vois si cela te convient en l'adaptant:

Option Explicit
'https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/
Dim ligne, f, d, racine, fs, dossier_racine, recherche
Dim existe As Boolean
Sub arborescenceRepertoire()
recherche = InputBox("Saisissez le nom du dossier : ", "Recherche dossier", "19123001")
  racine = "C:\Users\moi\Documents\entreprise\devis\"   ' adapter répertoire
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 1
  Lit_dossier dossier_racine, 1
     If existe = False Then MsgBox "Il n'y a aucun dossier à ce nom!", vbInformation, " Recherche dossier"
If IsNumeric(Range("H1")) Then
Range("H2").Value = Range("H1").Value + 1
End If
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name
Range("H1").Value = dossier.Name
  If dossier.Name = recherche Then
  MsgBox "Le dossier " & recherche & " existe déjà!", vbInformation, " Recherche dossier"
existe = True
Else
existe = False
End If
Cells(ligne, niveau).Font.ColorIndex = 0
   ligne = ligne + 1
 For Each f In dossier.Files
   Cells(ligne, niveau) = f.Name
   Cells(ligne, niveau).Font.ColorIndex = 3
   ligne = ligne + 1
 Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub


@+ Le Pivert