Verifier si dossier contient chaine de caractères

yanndebretagn Messages postés 104 Statut Membre -
cs_Le Pivert Messages postés 8437 Statut Contributeur - 2 janv. 2020 à 14:45

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

Afficher la suite

6 réponses

Réponse 1 / 6
cs_Le Pivert Messages postés 8437 Statut Contributeur 730

Bonjour,

voir ceci:

https://excel-malin.com/codes-sources-vba/vba-verifier-si-dossier-existe/
0
Réponse 2 / 6
yanndebretagn Messages postés 104 Statut Membre 2

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
0
1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
  
  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
  
  0
Réponse 3 / 6
yanndebretagn Messages postés 104 Statut Membre 2

re
pour f1 dir: rien du tout
pour ton exemple, là tu m'as perdu
0
Réponse 4 / 6
yanndebretagn Messages postés 104 Statut Membre 2
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?
0
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Réponse 5 / 6
yanndebretagn Messages postés 104 Statut Membre 2

je ferme et reformule
a bientôt
0

cs_Le Pivert Messages postés 8437 Statut Contributeur 730

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 104 Statut Membre 2

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 8437 Statut Contributeur 730 > yanndebretagn Messages postés 104 Statut Membre

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

Verifier si dossier contient chaine de caractères

6 réponses

Discussions similaires

Newsletters