Microsoft 365 VBA Création dossier + sous dossier + enregistrer le fichier dans le dossier

raf26

XLDnaute Occasionnel
Bonjour à vous,

Après avoir pas mal cherché et essayé d'adapter différentes solutions, je rame complètement sur une macro qui me permettrait de :

Créer un dossier (nommé avec la valeur d'une cellule) sur le bureau
Créer dans ce dossier un sous dossier (également nommé avec la valeur d'une cellule)
Enregistrer le fichier (également nommé avec la valeur d'une cellule) dans le dossier créé (le sous dossier reste vide).

Je vous remercie par avance de votre contribution.

Bonne journée ;)
 

Pièces jointes

  • test1.xlsx
    19.1 KB · Affichages: 6
Solution
re
VB:
Sub TESTONS()
    'Variables
    Dim maitre$, Nom$, AllFolders As Variant, F1$, F2$, PdfPath$
    'Identifier le chemin par défaut du bureau
    maitre = CreateObject("WScript.Shell").specialFolders("Desktop")

    'collection des noms de dossier dans un array(pas de limite d'arborescence)
    AllFolders = Array(maitre, [H9], [H10])

    'compilation dans la variable "F" dans une boucle sur l'array(Allfolders)
    For i = 0 To UBound(AllFolders)
       If i <= 1 Then
       F1 = F1 & AllFolders(i) & "\"
         If Dir(F1, vbDirectory) = vbNullString Then MkDir F1 'Si le dossier n'existe pas, on le crée
   F2 = F1
   Else
       F2 = F2 & AllFolders(i)
            If Dir(F2, vbDirectory) = vbNullString Then MkDir F2 'Si le dossier...

raf26

XLDnaute Occasionnel
Bonjour @patricktoulon

Merci j’ai réussi à adapter avec les noms de fichiers aux miens cela est parfait.

Par contre le fichier Excel et le fichier collé par la macro, les 2 sont positionnés dans le sous dossier créé.

Comment faire pour que ces 2 fichiers soient dans le dossier principal créé et non pas dans le sous dossier ?

Voici l’arborescence que je souhaite

Dossier

Fichier Excel qui contient cette lacro
Fichier copié et renommer par la macro

Sous dossier (vide)


Cordialement
 

patricktoulon

XLDnaute Barbatruc
re
VB:
Sub TESTONS()
    'Variables
    Dim maitre$, Nom$, AllFolders As Variant, F1$, F2$, PdfPath$
    'Identifier le chemin par défaut du bureau
    maitre = CreateObject("WScript.Shell").specialFolders("Desktop")

    'collection des noms de dossier dans un array(pas de limite d'arborescence)
    AllFolders = Array(maitre, [H9], [H10])

    'compilation dans la variable "F" dans une boucle sur l'array(Allfolders)
    For i = 0 To UBound(AllFolders)
       If i <= 1 Then
       F1 = F1 & AllFolders(i) & "\"
         If Dir(F1, vbDirectory) = vbNullString Then MkDir F1 'Si le dossier n'existe pas, on le crée
   F2 = F1
   Else
       F2 = F2 & AllFolders(i)
            If Dir(F2, vbDirectory) = vbNullString Then MkDir F2 'Si le dossier n'existe pas, on le crée
   End If
   Next

    'Nom du fichier
    Nom = F1 & [H11]

    'Identifier le chemin du pdf
    PdfPath = F & "Essai_" & [H11] & ".pdf"

    'Enregistrement du fichier
    ThisWorkbook.SaveAs Filename:=Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    Dim Origin$
    Origin = "C:\documents\essai.pdf"
    Nom = Mid(Origin, InStrRev(Origin, "\") + 1)
    FileCopy Origin, F1 & "Essai_" & Nom

    MsgBox "Votre fichier a été enregistré avec succès."
End Sub
 

Discussions similaires

Réponses
5
Affichages
226

Statistiques des forums

Discussions
314 709
Messages
2 112 103
Membres
111 417
dernier inscrit
LYTH