VBA - Chemin de dossier partiel

Bonjour à vous,

Je suis en train de créer un UserForm permettant de créer un devis automatiquement et de l'enregistrer dans son dossier. J'ai créer le code ci-dessous pour vérifier si le chemin d'enregistrement existe, ensuite l'enregistrer en configurant la mise en forme de la feuille Excel.

Je voudrai savoir comment je peux faire pour avoir un chemin de dossier partiel, au niveau du nom de l'entreprise. En effet avec l'étoile ça ne fonctionne pas. Le dossier s'appelle "3. NomEntreprise", et je voudrai qu'avec juste le nom de l'entreprise il trouve le dossier, et ne pas prendre en compte la numérotation du dossier.

    num_devis = Sheets("DE").Range("L21").Value
    der = Sheets("DE").Range("L15").Value
    NomEntreprise = Sheets("Feuil1").Range("T18").Value
    MonDossier = "G:\Drive partagés\Impact Icam GPS\2022-2023\7. Projets en cours\1. Suivi d'étude\*" & NomEntreprise & "\Dev Co\2. Devis d'Etude"

        'Vérifie si les dossiers existent

        If Len(Dir(MonDossier, vbDirectory)) > 0 Then

            'Enregistre le fichier excel

            With ThisWorkbook.Sheets("Feuil2")
                Set zoneEnregistree = .Range("A1:G59")
                NomEntreprise = Sheets("Feuil1").Range("T18").Value
                dossierSauvegarde = MonDossier
                nomFichier = "00" & num_devis & " DE"
            End With

            Set newWbk = Application.Workbooks.Add
            zoneEnregistree.Copy
            newWbk.Sheets(1).Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            ActiveWindow.DisplayGridlines = False
            ActiveWindow.View = xlPageBreakPreview
            ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
            ActiveSheet.PageSetup.PrintArea = "$A$1:$G$59"
            newWbk.SaveAs dossierSauvegarde & "\" & nomFichier
            newWbk.Close True

            MsgBox ("Le devis " & nomFichier & " à bien été créé !")

        Else

            MsgBox ("Attention tu n'as pas créé les dossiers... :/")

        End If

En vous remerciant par avance

Valentin

Bonjour,

MonDossier = "G:\Drive partagés\Impact Icam GPS\2022-2023\7. Projets en cours\1. Suivi d'étude\" & "*" & NomEntreprise & "\Dev Co\2. Devis d'Etude"

Merci de ta réponse, j'ai appliqué la modification mais il me met une erreur à la ligne :

newWbk.SaveAs dossierSauvegarde & "\" & nomFichier

Le message d'erreur en question :

Je crois qu'il considère l'étoile comme un caractère dans le nom du dossier

Help :(

Re bonjour, manque l'extension pour le nom de fichier d'enregistrement.

nomFichier = "00" & num_devis & " DE.xlsx"

Re bonjour, ça ne marche toujours pas. Il considère que l'étoile fais partie du nom du dossier et non comme on le voudrait...

ok il faut donc noter l'adresse quand il trouve le répertoire par exemple avec "DOSSIERFINAL"

'Vérifie si les dossiers existent

        If Len(Dir(MonDossier, vbDirectory)) > 0 Then
        DOSSIERFINAL = Dir(MonDossier, vbDirectory)

            'Enregistre le fichier excel

            With ThisWorkbook.Sheets("Feuil2")
                Set zoneEnregistree = .Range("A1:G59")
                NomEntreprise = Sheets("Feuil1").Range("T18").Value
                dossierSauvegarde = DOSSIERFINAL
                nomFichier = "00" & num_devis & " DE.xlsx"
            End With

Il me dit que le dossierSauvegarde = " ", avec avant un message d'erreur

Bizarre j'ai testé de mon coté j'ai bien l'adresse.

Tu n'a pas oublié la ligne en dessous de

If Len ?

DOSSIERFINAL = Dir(MonDossier, vbDirectory)

J'ai ça comme code au final :

    num_devis = Sheets("DE").Range("L21").Value
    der = Sheets("DE").Range("L15").Value
    NomEntreprise = Sheets("Feuil1").Range("T18").Value
    MonDossier = "G:\Drive partagés\Impact Icam GPS\2022-2023\7. Projets en cours\1. Suivi d'étude\" & "*" & NomEntreprise & "\Dev Co\2. Devis d'Etude"

        'Vérifie si les dossiers existent

        If Len(Dir(MonDossier, vbDirectory)) > 0 Then
        DOSSIERFINAL = Dir(MonDossier, vbDirectory)
            'Enregistre le fichier excel

            With ThisWorkbook.Sheets("Feuil2")
                Set zoneEnregistree = .Range("A1:G59")
                NomEntreprise = Sheets("Feuil1").Range("T18").Value
                dossierSauvegarde = DOSSIERFINAL
                nomFichier = "00" & num_devis & " DE.xlsx"
            End With

            Set newWbk = Application.Workbooks.Add
            zoneEnregistree.Copy
            newWbk.Sheets(1).Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            ActiveSheet.Paste
            ActiveWindow.DisplayGridlines = False
            ActiveWindow.View = xlPageBreakPreview
            ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
            ActiveSheet.PageSetup.PrintArea = "$A$1:$G$59"
            newWbk.SaveAs dossierSauvegarde & "\" & nomFichier
            newWbk.Close True

            MsgBox ("Le devis " & nomFichier & " à bien été créé !")

        Else

            MsgBox ("Attention tu n'as pas créé les dossiers... :/")

        End If

Et oui même avec, ça ne fonctionne pas..

Tu peux vérifier ce que renvoi excel par message box

DOSSIERFINAL = Dir(MonDossier, vbDirectory)
msgbox Dir(MonDossier, vbDirectory)

Voila la réponse :

Si c'est vide alors c'est que le Len(Dir(MonDossier, vbDirectory)) > 0 n'est pas plus grand que zéro et que le dossier n'est pas trouvé normalement ?

Pourtant il existe c'est le "3. Naudet"

Et si tu demandes

msgbox Len(Dir(MonDossier, vbDirectory))

il trouve combien en nombre ? > 0 ?

Il me met "0"

Si 0 alors le chemin n'existe pas pour lui.

Bien vérifier l'adresse ( les espaces, les points , les majuscules ... ) exemple le " . " derrière le 3 il existe bien ? et dans tous les répertoires ?

Test sans l' " * " pour voir si répertoire trouvé.

J'ai testé sans "*", ça marche dans le cas ou il n'y a pas le "3. ".

Le chemin exact est le suivant :

G:\Drive partagés\Impact Icam GPS\2022-2023\7. Projets en cours\1. Suivi d'étude\3. Naudet\Dev Co\2. Devis d'Etude

Dans mon code il récupère le nom de l'entreprise "NomEntreprise", il me semblait qu'avec l'étoile il prenait le dossier contenant le mot "NomEntreprise" donc ça ne devrait pas être un problème avec le "3" ou "." ou même l'espace.

et comme çà ?

MonDossier = "G:\Drive partagés\Impact Icam GPS\2022-2023\7. Projets en cours\1. Suivi d'étude\" & "*" &". "&NomEntreprise& "\Dev Co\2. Devis d'Etude"

Non, fonctionne toujours pas et me dit que c'est égale à 0..

Peut-être que ça ne marche pour les drives partagés ?