Verifier si dossier contient chaine de caractères
yanndebretagn
Messages postés
100
Date d'inscription
Statut
Membre
Dernière intervention
-
cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention -
cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention -
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
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
A voir également:
- Verifier si dossier contient chaine de caractères
- Dossier appdata - Guide
- Caractères ascii - Guide
- Impossible de supprimer un dossier - Guide
- Verifier compatibilite windows 11 - Guide
- Vérifier si mot de passe piraté - Guide
6 réponses
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
tjrs aussi réactif
j'ai vu cette page mais le problème le code ne gère pas les sous répertoires
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
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
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
pour que ça colle
une idéee?
</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?
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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/
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
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
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
Vois si cela te convient en l'adaptant:
@+ Le Pivert
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