If sous repertoire contient

Résolu
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   -  
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   -
re le fofo,

Je cherche à faire :
Savoir si dans le dossier C :\Users\MOI\Documents\ENTREPRISE\devis\XYZ \devis n°19123001 monsieur PATATE PARIS CONTIENT 19123001
True
False

SACHANT QUE XYZ PEU ETRE TOUT ET N’IMPORTE QUOI genre YZX
help me

25 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,
Tout a fait Thierry, mais le 19123001 se trouve dans le titre fichier ou...??????????
Pouvez detailler un peu plus?
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
Salut f8

pour être plus précis:
dossier: C :\Users\MOI\Documents\ENTREPRISE\devis\monsieur PATATE\
sous dossier: devis n°19123001 monsieur PATATE PARIS

ce que je cherche à faire:
savoir si le numéro 191230O1 a déjà été attribué sinon le sous dossier aurait le N°+1
soit 191230O2 et ainsi de suite jusqu'au numéro non attribué

voila
bonne fête et à bientôt
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonjour,

Exemple :
Option Explicit
Sub Test()
Dim dossier As String
Dim sousDos As String
Dim fichier As String
Dim cherche As String
Dim trouvee As Boolean
Dim t() As String
Dim i As Long

  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\"
  cherche = "19123001"
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        i = i + 1
        ReDim Preserve t(1 To i)
        t(i) = dossier & sousDos & "\"
      End If
    End If
    sousDos = Dir
  Loop
  For i = LBound(t) To UBound(t)
    fichier = Dir(t(i))
    Do While fichier <> ""
      If InStr(1, fichier, cherche, vbBinaryCompare) > 0 Then
        trouvee = True
        Exit Do
      End If
      fichier = Dir
    Loop
    If trouvee Then Exit For
  Next i
  If trouvee Then MsgBox fichier

End Sub
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
bonjour patrice
merci pour le code mais j'ai un erreur "fichier introuvable" sur la ligne
 If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then

...
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Quelles sont les valeurs de dossier et sousDos quand l'erreur se produit ?
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780 > Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention  
 
Il y a une erreur dans le nom de dossier que tu as donné (un espace après le C) corriges par :
  dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
RE
pour dossier:
dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"

pour souDos:
sousDos = Dir(dossier, vbDirectory)
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
As-tu corrigé le code comme précisé ci dessus ?
Quelle est la valeur de sousDos quand ça plante (pas la ligne de calcul).
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
RE
c'est là que je ne pige pas
il n'y a pas un sous dossier mais un paquet
donc je ne connais pas la valeur de sousdos
...
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Quand la macro s'arrête, le debogueur indique la ligne en cause, il suffit de passer le curseur sur les varaibles pour connaître leur valeur.
Voir : https://darkvader.developpez.com/tutoriels/vb/debogage-visual-basic-6/#LII-1-5
Et : https://tutoriel-vba.espaceweb.usherbrooke.ca/Documents/VBA%20Excel%20-%20D%C3%A9boguer%20un%20programme%20VBA.pdf

De toutes façons le code fourni devrait fonctionner, la seule ligne qui peut poser problème est celle qui définit le dossier (la 11). il faut que le dossier désigné existe.
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
ok je viens de comprendre
il bloque sur un sous dossier soit disant déplacé ou supprimé mais qui est tjrs présent
donc impossible a virer, ni renommer, ni déplacer
va comprendre
on se revoie (j’espère) l'année prochaine
passer une bonne soirée
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
bonjour a tous et tout plein de bonne chose pour cette nouvelle année

concernant mes fichiers litigieux, le problème est réglé,
maintenant la macro ce lance et va jusqu'au bout mais rien ne ce passe, grrrrrrrrrrr!!!!!
si je renseigne en dur un nom de dossier ou sous dossier le problème est identique
la macro ne les détecte pas
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Avec quel OS ?, Quelle version Excel ?

«si je renseigne en dur un nom de dossier ou sous dossier le problème est identique. la macro ne les détecte pas»
C'est à dire ? Cette macro détecte des fichiers contenus dans les sous-dossiers du dossier spécifié, s'il n'y sont pas, il ne se passe rien.
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
WIN 10 AVEC EXCEL 2007

cherche = "19123001"
- 19123001 représente une partie du nom du sous dossier
- le nom complet est devis n°19123001 monsieur PATATE PARIS
- 19123001 est dans page("renseignement client").cellule("B22")

sauf erreur pour trouver le texte qui ce trouve dans page("renseignement client").cellule("B22") dans l’arborescence je doit faire

cherche = "*" & Sheets("renseignement client").Range("B22").Value & "*"

ou quelque chose comme ça...
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Je croyais que tu cherchais un fichier, pour un sous-dossier c'est plus simple :
Option Explicit
Sub Test()
Dim dossier As String
Dim sousDos As String
Dim cherche As String
Dim trouvee As Boolean

  dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"
  cherche = Worksheets("renseignement client").Range("B22").Value
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If InStr(1, sousDos, cherche, vbBinaryCompare) > 0 Then
          trouvee = True
          Exit Do
        End If
      End If
    End If
    sousDos = Dir
  Loop
  If trouvee Then MsgBox sousDos

End Sub

0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
mea culpa
je cherche à savoir si le n° devis a déjà été attribué

pour attribuer le n° du devis je passe par la cellule B22
ce qui donne:
aa\mm\jj+n° devis du jour le 02/01/2020
soit pour ce jour devis 1
20010201
et pour ce jour devis 2
20010202

je fais appel à votre contribution pour tester si dans l’arborescence des devis créer il existe un devis nommé 20010201
sinon ajouter +1 à cellule B22 et tester si devis nommé 20010202
si devis 20010202 existe +1 à cellule B22 et tester si devis nommé 20010203
ETC ETC
donc dans l’arborescence ce n'est pas (sous dossier arborescence =B22 ) mais
(sous dossier arborescence CONTIENT B22 )mais ça je gère (je crois)

j’espère que j'ai été plus clair et UN GRAND MERCI (pat) POUR VOTRE AIDE ET PATIENCE
yann
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour et meilleurx vœux,

Excusez l'incruste svp, je suis de loin votre affaire.

Si vous gérez par numero de devis, et pi tete qu'une simple mise en memoire du dernier num devis serait plus simple ou a la limite memoriser tous les num devis est faire un test si le "nouveau" existe,
De plus, savon pas par quoi ce num est ecrit, a la mano en auto…...
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
Salut f8,
Tjrs content de te lire

Concernant l’établissement de la numérotation des devis je procède comme ça :
EN B19 =AUJOURDHUI()
EN B20 =TEXTE(B19;"aammjj")
EN B21=N° DEVIS attribué manuellement
Et EN B22=CONCATENER(B20; B21)
ce qui donne pour ce jour le 03/01/2020
EN B19 =03/01/2020
EN B20 =200103
EN B21=01 (pour devis 1)
Et EN B22=20010301

Tu dis a la limite memoriser tous les num devis est faire un test si le "nouveau" existe,
C_pivert ma donné un code qui me permet de ressortir l’arborescence du fichier devis dû coup je peux faire une recherche sur la numérotation
Mais j’ai un problème de boucle, je suis obliger de relancer la macro à chaque fois pour quelle retrouve un numéro de devis identique

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
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonjour et bonne année,

Si tu avais expliqué ça dès le début, on aurait perdu moins de temps
Inutile de lire sur la feuille, VBA calcule ça très bien :
Option Explicit
Sub Test()
Dim n°devis As String
  
  n°devis = NumeroDevis
  MsgBox n°devis
  
End Sub

Private Function NumeroDevis() As String
Dim dossier As String
Dim sousDos As String
Dim cherche As String
Dim n°devis As Integer
Dim maximum As Integer

  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\"
  dossier = ThisWorkbook.Path & "\Tmp\"
  cherche = Format(Date, "yymmdd")
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If sousDos Like "*" & cherche & "??*" Then
          n°devis = Val(Left(Mid(sousDos, InStr(1, sousDos, cherche) + Len(cherche)), 2))
          If n°devis > maximum Then maximum = n°devis
        End If
      End If
    End If
    sousDos = Dir
  Loop
  NumeroDevis = cherche & Format(maximum + 1, "00")

End Function


Et en B22 tu mets directement :
=NumeroDevis()

0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
désolé du tps perdu
bon,ben non
je lance la userforme, elle apparaît avec le numero 20010301
je click et rien
pourtant j'ai bien un devis qui contient 20010301 dans son nom
et le chemin est correct
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780 > yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention  
 
Quelle userform ?
Avec Quel Code ?

Il faut arrêter de donner les infos au compte goutte !!!!
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
pardon
je voulais dire MsgBox n°devis
et le dernier code que tu m'as donné
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Supprimes la ligne :
dossier = ThisWorkbook.Path & "\Tmp\"
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
non tjrs rien que le numéro du MsgBox corresponde ou pas a un numéro de devis déjà attribué
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Je teste pour voir…


Suite:

Code Patrice33740 ok avec sub test
Function Ok avec =NumeroDevis() dans B22

Donc ………….!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonjour le fil,

@ f894009 : Bonne Année et merci pour cette confirmation.

@yanndebretagn : Ça veut dire quoi « toujours rien » ? As-tu compris ce que fait ce code ?

Il fournit automatiquement en B22 le numéro du prochaine devis, en examinant les numéros de devis déjà attribués aujourd'hui et dont le sous-répertoire existe.
B19, B20 et B21 sont devenus totalement inutiles, tu peux les effacer.

Pour que le numéro s'actualise automatiquement à chaque modification de la feuille, tu peux ajoute au début de la fonction (avant la ligne 17) :
  Application.Volatile

Mais, en deux mots, je l'évite car ça mobilise systématiquement des ressources.

0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
bonjour patrice et f8,

Merci de votre patience (surtout toi patrice)
en faite la macro cherche si dans "C :\Users\MOI\Documents\ENTREPRISE\devis\"
mais il y a encore des sous dossiers avant que le n° de devis apparaisse ce qui donne:
"C :\Users\MOI\Documents\ENTREPRISE\devis\nom&prénom_client\N°devis"
forcément nom&prénom_client est variable
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Re,
Apres relecture en partant du debut:
Ok , il manque un niveau dans recherche pour le rep nom&prenom qui correspond au XXX du depart de facon a trouver ou pas le rep N°devis
Donc dans le code de Patrice33740 il faut ajouter cette partie. Z'etes chaud bouillant ou pas??
0
yanndebretagn Messages postés 100 Date d'inscription   Statut Membre Dernière intervention   2
 
je ne sais pas a quoi m'attendre
fait moi rêver f_8
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Re,

Pour le moment j'ai un soucis sur le premier sousDos=Dir apres avoir le premier sousDos et fait une recherche dans le dit sousDos avec aussi un Dir et pas trouver le rep
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Re,

Je ne vois pas où est la difficulté !
Comme tu ne nous dit pas il trouver Nom & Prènom, j'ai supposé qu'on le trouve en B4 (à toi d'adapter) :
Option Explicit
Sub Test()
Dim n°devis As String
  
  n°devis = NumeroDevis
  MsgBox n°devis
  
End Sub

Private Function NumeroDevis() As String
Dim dossier As String
Dim sousDos As String
Dim nomPrenom As String
Dim cherche As String
Dim n°devis As Integer
Dim maximum As Integer

  Application.Volatile
  nomPrenom = Worksheets("renseignement client").Range("B4").Value
  dossier = "C :\Users\MOI\Documents\ENTREPRISE\devis\" & nomPrenom & "\"
  cherche = Format(Date, "yymmdd")
  sousDos = Dir(dossier, vbDirectory)
  Do While sousDos <> ""
    If sousDos <> "." And sousDos <> ".." Then
      If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then
        If sousDos Like "*" & cherche & "??*" Then
          n°devis = Val(Left(Mid(sousDos, InStr(1, sousDos, cherche) + Len(cherche)), 2))
          If n°devis > maximum Then maximum = n°devis
        End If
      End If
    End If
    sousDos = Dir
  Loop
  NumeroDevis = cherche & Format(maximum + 1, "00")

End Function


0