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

wDog66

XLDnaute Occasionnel
Bonjour,
Avec une petite recherche, vous pouvez trouver ceci
Cela vous aidera peut-être 😉
 

piga25

XLDnaute Barbatruc
Bonjour,
Un essais avec cela :
VB:
Sub TESTONS()
    'Variables
    Dim chemin As String
    Dim chemin_dossier As String
    Dim chemin_sous_dossier
    Dim Nom As String
    
    'Identifier le chemin par défaut du bureau
    chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
    
    'Identifier le chemin du dossier
    chemin_dossier = chemin & "\" & [H9] & "\"
    
    'Tester l'existence du dossier
    If Dir(chemin_dossier, vbDirectory) = vbNullString Then
        'Si le dossier n'existe pas, le créer
        MkDir chemin_dossier
    End If
    
     'Identifier le chemin du sous-dossier
    chemin_sous_dossier = chemin_dossier & [H10] & "\"

    ' Tester l'existence du sous-dossier
    If Dir(chemin_sous_dossier, vbDirectory) = vbNullString Then
        ' Si le dossier n'existe pas, le créer
        MkDir chemin_sous_dossier
    End If
  
    
    ' Construire le nom complet du fichier (en vérifiant la concaténation)
    Nom = chemin_sous_dossier & [H11] & ".xlsm"

    ' Afficher le chemin complet pour vérification
    MsgBox "Le fichier sera enregistré à cet emplacement : " & Nom

    ActiveWorkbook.SaveAs Filename:=Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

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

patricktoulon

XLDnaute Barbatruc
Bonjour @piga25
on peut compiler histoire de rendre le code moins long
VB:
Sub TESTONS()
    'Variables
    Dim maitre$, Nom$, AllFolders As Variant, F$

    '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)
        F = F & AllFolders(i) & "\"
        If Dir(F, vbDirectory) = vbNullString Then MkDir F 'Si le dossier n'existe pas, on le crée
    Next

    'Nom du fichier
    Nom = F & [H11]

    ActiveWorkbook.SaveAs Filename:=Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

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

raf26

XLDnaute Occasionnel
Bonjour,

Merci @piga25 et @patricktoulon

Vos 2 solutions me conviennent parfaitement ! 🙏



J'aimerais ajouter un élément lors de l'exécution de la macro (à la fin)


Je voudrais copier le fichier stocké dans C:\documents\essai.pdf

dans le dossier nouvellement créé sur le bureau et le renommer en : essai + valeur H11.pdf

Cordialement
 

patricktoulon

XLDnaute Barbatruc
pourquoi le faire dans deux dossiers?
VB:
Sub TESTONS()
    'Variables
    Dim maitre$, Nom$, AllFolders As Variant, F$, 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)
        F = F & AllFolders(i) & "\"
        If Dir(F, vbDirectory) = vbNullString Then MkDir F 'Si le dossier n'existe pas, on le crée
    Next

    'Nom du fichier
    Nom = F & [H11]

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

    'Enregistrement du fichier
    ThisWorkbook.SaveAs Filename:=Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    'Enregistrement au même endroit en pdf
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfPath, Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

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

raf26

XLDnaute Occasionnel
Re,

Il ne s'agit pas du fichier Excel , mais d'un autre.

Actuellement, manuellement :

après avoir crée le dossier, je copie un fichier (on va l'appeler bordereau.xls stocké dans Mes documents) dans ce dossier créé et je le renomme en bordereau_janvier_durant.xls

Je voulais profiter de la macro pour automatiser cette copie.
 

raf26

XLDnaute Occasionnel
J'arrive en vba à copier un fichier avec FileCopy

VB:
Dim FichierOriginal As String
Dim FichierCopie As String
 
FichierOriginal = "C:\Test\MonFichier.txt"
FichierCopie = "C:\Archive\MonFichier_archive.txt"
 
FileCopy FichierOriginal, FichierCopie

mais là je ne sais pas comment indiquer dans la ligne FichierCopie que le dossier de destination est celui qui vient d'etre créé par la macro
 

wDog66

XLDnaute Occasionnel
J'arrive en vba à copier un fichier avec FileCopy

VB:
Dim FichierOriginal As String
Dim FichierCopie As String
 
FichierOriginal = "C:\Test\MonFichier.txt"
FichierCopie = "C:\Archive\MonFichier_archive.txt"
 
FileCopy FichierOriginal, FichierCopie

mais là je ne sais pas comment indiquer dans la ligne FichierCopie que le dossier de destination est celui qui vient d'etre créé par la macro
Bonsoir,
Juste une question, si vous ne savez pas utiliser les variables, pourquoi utiliser VBA 🤔
 

raf26

XLDnaute Occasionnel
Bonsoir
J’utilise VBA pour simplifier, automatiser, gagner du temps.
Je n’ai jamais étudié les langages informatiques, et oui je ne maîtrise pas les variables.
J’adapte des macros chinees ici ou là à mes besoins professionnels, quand ça ne marche pas je cherche je cherche et au besoin je me tourne vers un forum d’entraide tel que celui-ci.

Si tout le monde maîtrisait tout, ce forum n’existerait pas
 

wDog66

XLDnaute Occasionnel
Bonsoir
J’utilise VBA pour simplifier, automatiser, gagner du temps.
Je n’ai jamais étudié les langages informatiques, et oui je ne maîtrise pas les variables.
J’adapte des macros chinees ici ou là à mes besoins professionnels, quand ça ne marche pas je cherche je cherche et au besoin je me tourne vers un forum d’entraide tel que celui-ci.

Si tout le monde maîtrisait tout, ce forum n’existerait pas
Connaître l'utilisation des variables n'est pas maîtriser VBA et de très loin... mais juste une des bases de ce langage 🙄

Je dirai même LA base de ce langage

Donc aucun problème avec l'existence de ce forum et d'autres

Mais commencez donc pas vous former à leur utilisation 😉👍
 

patricktoulon

XLDnaute Barbatruc
dans le code que je t'ai donné cet aprem c'est fait et en place
donc au final ça donne ça
VB:
Sub TESTONS()
    'Variables
    Dim maitre$, Nom$, AllFolders As Variant, F$, 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)
        F = F & AllFolders(i) & "\"
        If Dir(F, vbDirectory) = vbNullString Then MkDir F 'Si le dossier n'existe pas, on le crée
    Next

    'Nom du fichier
    Nom = F & [H11]

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

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

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

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

Discussions similaires

Réponses
5
Affichages
272

Statistiques des forums

Discussions
315 093
Messages
2 116 123
Membres
112 666
dernier inscrit
Coco0505