Lister sous-dossiers / Récupérer information dans titre

Salut les accros,

Mes collègues ont des demandes plus farfelues les unes que les autres, cela m’éclate et augmente mes compétences mais me prends parfois bien la tête

J'ai un fichier devis, qui lorsque l'on crée un nouveau devis va générer sur notre serveur des dossiers et sous dossiers. Exemple:

Dossier -> "Devis 1"

Sous-dossier -> "0 - Demande initiale" et "1 - Réponse du xx-xx-xxxx"

Puis Devis 2 / Devis 3....... Toujours la même boucle. Il y a ensuite les révisions qui sont gérés avec des sous-dossiers "2 - Réponse du xx-xx-xxxx" / "3 - Réponse du xx-xx-xxxx" etc...

Quand un commercial envoi un devis il change "xx-xx-xxxx" par la date d'envoi et ma collègue préférée souhaite récupérer cette date dans une cellule

J'ai donc commencer à coder en essayant de récupérer la liste des dossiers, dans le but ensuite de cibler celui qui m'intéresse. J'ai donc créé sur mon bureau un dossier "Test" avec à l'intérieur les sous-dossiers "0 - Demande initiale" et "1 - Réponse du xx-xx-xxxx" pour mes tests. En appuyant sur mon bouton j'obtiens une liste de 4 sous-dossiers -> "." / ".." / "0 - Demande initiale" et "1 - Réponse du xx-xx-xxxx".

Je ne sais pas d’où viennent les "." et "..", j'ai vu trainer ça sur un page mais qui n'expliquait pas le pourquoi. Mais peu importe je me dis que j'ai juste à les ignorer.

Du coup je continue à coder en mettant un IF pour virer les dossiers qui ne m'intéressent pas et la ça tourne en boucle ou ca me dit capacité dépassé selon ou je place le End If (Avant ou après le J = J +1) et je bloque...

Voici mon code:

Option Explicit

Sub M6_Vérifier_Réponse_DT()

    Dim NombreDevis As Integer
    Dim OldDossier As String
    Dim NewDossier As String
    Dim i As Integer
    Dim J As Integer
    Dim NuméroDevis As Integer
    Dim AnnéeDevis As Integer
    Dim NomClient As String
    Dim CheminFinalDevis As String

    Application.ScreenUpdating = False

    Devis_Technique.Activate
    NombreDevis = Application.WorksheetFunction.CountA(Range("A2", Cells(Rows.Count, "A").End(xlUp)))

    For i = 2 To NombreDevis + 1
        If Devis_Technique.Cells(i, "G") = "" Then
            NuméroDevis = Devis_Technique.Cells(i, "A")
            AnnéeDevis = Year(Devis_Technique.Cells(i, "D"))
            NomClient = Devis_Technique.Cells(i, "J")
        End If

        CheminFinalDevis = "C:\Users\Heelflip\Desktop\Test 2\*"
        OldDossier = Dir(CheminFinalDevis, vbDirectory)

        Do While OldDossier <> ""
            'If OldDossier <> "." And OldDossier <> ".." Then
            Feuil1.Cells(J + 1, 1) = CheminFinalDevis
            Feuil1.Cells(J + 1, 2) = OldDossier
            OldDossier = Dir()
           ' Do While OldDossier <> ""
           '     If OldDossier <> "." And OldDossier <> ".." And OldDossier <> "0 - Demande initiale" Then
           '     Feuille.Cells(J + 1, 3) = OldDossier
           '     End If
           ' Loop
           'End If
           J = J + 1
        Loop
    Next i
End Sub

J'ai aussi une question concernant la récupération de la date, est-ce qu'un Left fonctionne sur le nom d'un dossier ?

Je joindrais le fichier quand le service sera de nouveau disponible.

Merci.

Voici le fichier

Bonsoir

si j'ai bien compris le mécanisme... et la demande

voici une proposition

Avec les dossiers de test que j'ai fait et mis sur mon bureau :

évidemment dans le code cette ligne sera à adapter :

CheminFinalDevis = "C:\Users\fred\Desktop\Test"

Fred

Bonjour Fred,

Moi qui me demande toujours si mes explications sont claires ça fait plaisir car c'est exactement cela

Par contre si je mets une date avec un jour de 1 à 12 la fonction met une date à l'anglaise, 11/05/2022 au lieu de 05/11/2022. Pourtant je suis bien sur une date avec France en paramètres régionaux. Si je passe les cases en texte il copie normalement.

Un grand merci en tout cas.

Juste quelques questions histoire de tout comprendre.

Dim CheminFinalDevis$

Pourquoi le $ ?

Sinon en test adapté dans mon fichier ça fonctionne faut si une ligne dans l'excel n'a pas de dossier, au lieu de quitter il me met une erreur 76 "Chemin introuvable", il faut que je transforme cela en msgbox d'alerte.

Bonjour

ceci est une déclaration de variable "raccourcie"

Dim CheminFinalDevis$

que l'on peut aussi écrire aussi

Dim CheminFinalDevis as string

dans cette déclaration de fonction

Function Parcourir_dossier(chemin As String, Dossier_devis As String) As String

c'est une fonction attend 2 paramètres de type string, le premier le chemin de base, le 2e le numéro de devis (disponible en colonne A) qui permettra d'aller directement dans le bon dossier devis exemple

'si Dossier_devis = 1
chemin & "\devis " & Dossier_devis
'équivalent à "C:\Users\fred\Desktop\Test\devis 1"

ce numéro de devis est envoyé depuis la sub appelante de la fonction.. et arrive dans la fonction sous la variable "Dossier_devis"

cette fonction renvoi une chaine de caractère correspondant à la fin du nom du dossier trouvé dans ton exemple : "xx-xx-xxxx"

attention cependant je n'ai pas géré le cas ou le dossier devis n'existe pas... ce qui fait une erreur d'exécution du code dans ce cas.. a toi de voir si cela est une possibilité et dans ce cas il faudra le gérer..

je viens de voir qu'il restait aussi des déclarations de variables dans cette fonction qui ne sont pas utiles.. (fonction que j'avais dans ma bibliothèque de fonction et qui servait à d'autres choses initialement.. elles peuvent donc être supprimées)

    Dim FileItem As Object
    Dim fichier_en_traitement As String

concernant le format de date.. fait un essai en remplaçant la ligne

Cells(i, "G") = Replace(ret, "-", "/")

par celle ci :

Cells(i, "G") = Format(Replace(ret, "-", "/"), "mm/dd/yyyy")

Fred

Edit :

je viens de relire la fin de ton post... puisque tu l'as éditer pendant que je faisais la réponse..

si tu ne sais pas gérer l'erreur du dossier devis n'existant pas.. demande

Fred

Fred,

Oui désolé mais j'ai passé un peu de temps à l'analyser et j'ai édité mon post après avoir trouvé les réponses, en les trouvant moi même je progresse d'avantage je pense

Pour la date c'est réglé, ton bout de code supplémentaire fonctionne parfaitement

J'ai intégré mes variables et mes chemins c'est ok, j'ai intégré aussi un by-pass si la date n'est pas remplie, qui laisse la cellule vide au lieu de lui mettre xx-xx--xxxx. J'ai aussi intégré la gestion des révision et tout roule. Par contre je n'arrive pas stopper si le dossier n'existe pas, je pensais passer par un SourceFolder = vbNullString mais je n'arrive pas a l'intégrer au niveau du Set

Re bonjour

tu peux faire la vérification avant de faire le set.. avec par exemple ce petit morceau de code..

et donc faire la suite du programme seulement si le dossier existe.. donc dans la partie du else

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Not Fso.FolderExists(chemin & "\devis " & Dossier_devis) Then
        MsgBox "Le dossier " & chemin & "\devis " & Dossier_devis & " n'existe pas !"
    Else
        MsgBox "Le dossier " & chemin & "\devis " & Dossier_devis & " existe bien !"
    End If

Fred

Ré,

Ha bah oui c'est si bête que je bloque dessus
J'ai mis le MsgBox d'erreur et j'y ai ajouté un petit Exit Function. Cela affiche donc les erreurs et continue toutes les autres dates. Du coup la macro est nickel.
Encore un énorme merci pour ton aide.

Par contre j'ai vraiment du mal à comprendre la partie recherche des dossier ça fait un boucle de recherche sans être une boucle, j'aurai aimé poser un compteur pour dire à la fin il y a 3 erreurs par exemple mais du coup ça ne fonctionne ps vu que je n'ai pas de boucle, je vais aller apprendre tout ce qui touche au filesystemobject.

Re

si il est tout à fait possible de de faire une déclaration d'une variable globale que tu initialise à 0 avant de commencer a parcourir tes lignes

et dans ce cas tu incrémente cette variable a chaque fois que tu es dans le cas ou le dossier n'existe pas..

et à la fin du code tu affiche une msgbox avec le nombre d'erreur

Fred

Re,

C'est good, en fait je voulais le mettre dans la fonction Parcourir les fichiers alors que je devais la mettre dans la fonction Vérifier la réponse dans le For/Next.

Tout est ok, merci pour tout Fred et bonne journée à toi