Sélection sous-répertoire dont on ne connait que le début du nom

Bonjour,

Voici mon code :

Sub test()

If Mid(ThisWorkbook.Name, 2, 1) <> "0" Then

'MsgBox Mid(ThisWorkbook.Name, 2, 1)

repertoire = Mid(ThisWorkbook.Name, 2, 4)

'MsgBox repertoire

Else

repertoire = Mid(ThisWorkbook.Name, 3, 3)

'MsgBox repertoire

End If

Select Case repertoire

Case Is <= 100

repertoire1 = "001-100"

Case Is <= 200

repertoire1 = "101-200"

Case Is <= 300

repertoire1 = "201-300"

Case Is <= 400

repertoire1 = "301-400"

Case Is <= 500

repertoire1 = "401-500"

Case Is <= 600

repertoire1 = "501-600"

Case Is <= 700

repertoire1 = "601-700"

Case Is <= 800

repertoire1 = "701-800"

Case Is <= 900

repertoire1 = "801-900"

Case Is <= 1000

repertoire1 = "901-1000"

Case Is <= 1100

repertoire1 = "1001-1100"

Case Is <= 1200

repertoire1 = "1101-1200"

Case Is <= 1300

repertoire1 = "1201-1300"

Case Is <= 1400

repertoire1 = "1301-1400"

Case Is <= 1500

repertoire1 = "1401-1500"

Case Is <= 1600

repertoire1 = "1501-1600"

Case Is <= 1700

repertoire1 = "1601-1700"

Case Is <= 1800

repertoire1 = "1701-1800"

Case Is <= 1900

repertoire1 = "1801-1900"

Case Is <= 2000

repertoire1 = "1901-2000"

End Select

'MsgBox repertoire1

Debutchemin = "W:\PE\Dossiers Projets"

'MsgBox Debutchemin

chemincomplet = Debutchemin & "\" & repertoire1 & "\"

MsgBox chemincomplet

End Sub

J'exécute cette macro sur un fichier toujours nommé Gxxxx-0000....xls. Elle détecte le numéro de dossier qui m'intéresse et sélectionne le chemin correspondant jusqu'à un certain point. Je cherche un solution pour trouver le chemin du dernier répertoire dont je ne connais que le début du nom et y créer un autre sous répertoire nommé "13 - Nomenclature".

Je m'explique par un exemple :

Mon fichier est le G1387-0000A12.xls

Ma macro trouve le 1387 et trouve le chemin W:\PE\Dossiers Projets\1301-1400\

Il y a encore 100 sous répertoires qui commencent tous par le numéro de dossier mais on plein de caractères après ici 1387 3823732.

Comment ajouter ce sous répertoire dans le chemin et y créer un sous répertoire "13 - Nomenclature" ?

Cordialement et merci pour vos réponses.

Bonjour,

je n'ai pas tout saisi, sinon que la longueur du CASE m'a fait peur...

Je ne sais si c'est mieux ou plus rapide, mais avec une boucle comme celle-ci dessous, le code est "plus" lisible, non ?

Option Explicit

Sub LouReeD()
    Dim i, repertoire, repertoire1
    repertoire = 499
    For i = 100 To 2000 Step 100
        If repertoire <= i Then
            repertoire1 = Format(i - 100 + 1, "000") & "-" & Format(i, "000")
            Exit For
        End If
    Next i
    MsgBox (repertoire1)
End Sub

Évidemment le code n'est pas adapter au votre, c'est juste pour montrer que la boucle est "moins longue" en ligne de code que le CASE.

@ bientôt

LouReeD

Bonjour,

Si je comprend bien, le dossier "1301-1400" qui a comme chemin "W:\PE\Dossiers Projets\1301-1400\" comporte au moins 100 sous-dossiers qui eux ont comme préfixe la partie du nom du fichier, ici dans ton exemple "1387" ?

Et ta question est :

Comment ajouter ce sous répertoire dans le chemin et y créer un sous répertoire "13 - Nomenclature" ?

Tu veux ajouter quel sous-répertoire ? Un répertoire portant le nom du fichier ou une partie du nom (dans ton exemple "G1387-0000A12.xls") et à ce sous-répertoire tu veux ajouter un autre répertoire nommé "13 - Nomenclature" ? Je dois dire que je m'y perd un peu

Merci pour vos réponses et pour le code qui remplace le Case .

Theze pour répondre à ta question les 100 sous dossiers du répertoire 1301-1400 ont bien pour préfixe le numéro de dossier (dans mon exemple 1387). Je souhaite créer un sous-répertoire "13 - Nomenclature" dans le sous dossier "1387xxxxxxxxxxx" où xxxxxxxxx sont des caractères inconnus ou variables. Mon problème est que je ne sais pas comment trouver le nom de ce sous répertoire et de le coller dans une variable par exemple.

J'espère que c'est un peu plus clair!!!!

Cordialement.

Voici le début de l'arborescence du répertoire 1301-1400 pour info.

Je cherche, je cherche mais toujours pas de solution

Bonjour,

je ne maitrise pas la gestion de fichiers/dossier sous Excel.

Mais l'idée pourrait être celle-ci :

on connait le dossier parent du 1387 => 1301-1400

Une boucle tourne sur tous les dossiers contenus dans celui-ci.

Un test de "match" sur la 4 premiers caractères.

Si c'est le cas on arrête la boucle et on connait le dossier, "facile" après de "renter" dedans pour y créer un dossier 13-nomenclature

En VBA il y a des fonctions qui permettent de tourner sur le contenu d'un dossier sans connaitre le nom de chacun des fichiers et il est possible alors de connaitre le nom du fichier testé, mais je le répète je ne suis pas assez callé, il doit cependant y avoir ici des fils parlant de ce sujet.

@ bientôt

LouReeD

Bonjour à tous,

Pour remplacer le Select Case, on peut faire encore plus court :

Dim Max As Integer

    Max = Int(CInt(repertoire) / 100) * 100
    repertoire1 = Format(Max - 99, "#000-") & Max

Voilà une adresse où theze avait répondu : https://forum.excel-pratique.com/viewtopic.php?p=185527#p185527

dans la boucle do While de la deuxième partie, il doit y avoir possibilité de faire un test "LIKE" entre 1387 et les 4 premiers caractère du nom, un truc comme ça :

If Left(Fichier, 4) = "1387" Then

Si les 4 premiers caractère du fichier = "1387" alors

et là il faut coder la création du dossier 13-Nomenclature dans ce dossier "fichier" lors de la boucle, et une fois fait on quitte la boucle...

@ bientôt

LouReeD

Note : merci pierrep56 !

Re à tous,

A partir du moment ou tu as récupéré ton "repertoire1", pour chercher un dossier genre "1387-blabla" tu peux faire :

Dim FSO As Object, Srep As Object
Dim Rep As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Srep In FSO.GetFolder(repertoire1).SubFolders
        If Left(Srep.Name, 4) = "1387" Then Rep = repertoire1 & "\" & Srep.Name
    Next Srep
    MsgBox Rep

Voilà !

C'est ce que je disais, mais je n'y connais rien en codage avec fichiers/ dossier / chemin....

@ bientôt

LouReeD

Bonjour,

En partant du code de LouReed, et en utilisant une Sub qui boucle sur les dossiers que contient le dossier dont on passe le chemin, on récupère dans un tableau passé en argument les noms des différents dossiers et si les 4 premiers caractères correspondent au 4 premier caractères du fichier, création du dossier "13 - Nomenclature" :

Sub LouReeD()

    Dim Tbl() As String
    Dim I As Long
    Dim Repertoire As Long
    Dim repertoire1
    Dim Chemin As String

    Repertoire = IIf(Mid(ThisWorkbook.Name, 2, 1) <> "0", Mid(ThisWorkbook.Name, 2, 4), Mid(ThisWorkbook.Name, 3, 3))

    For I = 100 To 2000 Step 100

        If Repertoire <= I Then

            repertoire1 = Format(I - 100 + 1, "000") & "-" & Format(I, "000")
            Exit For

        End If

    Next I

    Chemin = "W:\PE\Dossiers Projets\" & repertoire1 & "\"

    RecupDossiers Chemin, Tbl()

    If Not (Not Tbl()) Then

        For I = 1 To UBound(Tbl)

            'si les 4 premiers caractères correspondent, création du dossier "13 - Nomenclature"
            If Left(Tbl(I), 4) = Repertoire Then MkDir Chemin & "13 - Nomenclature"

        Next I

    End If

End Sub

Private Sub RecupDossiers(Dossier As String, Tbl() As String)

    Dim Fso As Object
    Dim Dos As Object
    Dim D As Object
    Dim DosParent As String
    Dim I As Long

    'mémorise le chemin du dossier
    DosParent = Dossier

    Set Fso = CreateObject("Scripting.FileSystemObject")

    If Fso.FolderExists(Dossier) = False Then Exit Sub

    Set Dos = Fso.GetFolder(Dossier)

    'boucle sur les sous-dossiers
    For Each D In Dos.SubFolders 'SousDos

        'stocke dans le tableau le nom du dossier
        I = I + 1: ReDim Preserve Tbl(1 To I)
        Tbl(I) = D.Name

    Next D

End Sub

Voilà, voilà, voilà, c'est ça que j'aurais voulu écrire avec les modifications de simplification de pierrep56 !

Merci @ vous theze et pierrep56, merci pour melvyndor !

@ bientôt

LouReeD

J'ai juste un peu compliqué la chose en faisant la comparaison dans la Sub appelante après retour du tableau car je ne voulais pas faire ça dans la Sub de récup des dossiers pour qu'elle puisse servir pour d'autre telle quelle !

Merci pour toutes vos réponses : j'essaie cela et je reviens vers vous

Je viens de tester ta macro Loureed : elle me crée bien le répertoire 13 - Nomenclature mais à un niveau trop haut. Je voudrais que 13 - Nomenclature soir le sous répertoire de 1387 - essai texte libre...

Et demande supplémentaire qu'il ne soit créé que s'il n'existe pas déjà.

Merci par avance pour toutes vos réponses

Re,

De cette façon alors :

Sub LouReeD()

    Dim Tbl() As String
    Dim I As Long
    Dim Repertoire As Long
    Dim repertoire1
    Dim Chemin As String

    Repertoire = IIf(Mid(ThisWorkbook.Name, 2, 1) <> "0", Mid(ThisWorkbook.Name, 2, 4), Mid(ThisWorkbook.Name, 3, 3))

    For I = 100 To 2000 Step 100

        If Repertoire <= I Then

            repertoire1 = Format(I - 100 + 1, "000") & "-" & Format(I, "000")
            Exit For

        End If

    Next I

    Chemin = "C:\Users\Delta-Calor\Downloads\" & repertoire1 & "\" '"W:\PE\Dossiers Projets\" & repertoire1 & "\"

    RecupDossiers Chemin, Tbl()

    If Not (Not Tbl()) Then

        For I = 1 To UBound(Tbl)

            'si les 4 premiers caractères correspondent, création du dossier "Nomenclature"
            If Left(Tbl(I), 4) = Repertoire Then

                On Error Resume Next
                MkDir Chemin & Tbl(I) & "\" & "13 - Nomenclature"
                On Error GoTo 0

            End If

        Next I

    End If

End Sub

Super ça fonctionne alors pour finir j'ai une dernière question :

est-il possible avant de faire le Mkdir qui crée le sous répertoire 13 - Nomenclature un test de présence de ce répertoire afin que la macro ne plante pas s'il existe déjà.

Cordialement.

Re,

La macro ne doit pas planter car j'ai mis en place un gestionnaire d'erreur !

On Error Resume Next
MkDir Chemin & Tbl(I) & "\" & "13 - Nomenclature"
On Error GoTo 0