If sous repertoire contient

Bonjour,
Tout a fait Thierry, mais le 19123001 se trouve dans le titre fichier ou...??????????
Pouvez detailler un peu plus?

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

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

bonjour patrice
merci pour le code mais j'ai un erreur "fichier introuvable" sur la ligne

 If (GetAttr(dossier & sousDos) And vbDirectory) = vbDirectory Then

...

RE
pour dossier:

dossier = "C:\Users\MOI\Documents\ENTREPRISE\devis\"

pour souDos:

sousDos = Dir(dossier, vbDirectory)

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
...

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

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

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...

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

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

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…...

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

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()

pardon
je voulais dire MsgBox n°devis
et le dernier code que tu m'as donné

non tjrs rien que le numéro du MsgBox corresponde ou pas a un numéro de devis déjà attribué

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.

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

je ne sais pas a quoi m'attendre
fait moi rêver f_8

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