Code VBA - Création Dossier et sous-dossiers pour enregistrer fichiers

Bonsoir à tous,

Pour un travail répétitif, je souhaite automatiser certaines tâches.
J’ai besoin de créer : un dossier avec des sous dossiers :

• Dossier (année)
• Sous dossiers (Mois : Janv. à Déc.)

Objectif :

Enregistrer le fichier du mois correspondant au sous-dossier respectif

Exemple : un fichier nommé, « 10 01 2021_Chambre.xlsx » dans sous dossier Janv.

Merci à l'avance de votre aide.

Juju

Bonjour,

Pour créer un dossier ou un sous dossier c'est simple, par exemple :

MkDir "C:\Users\pierrep\Documents\Exemple_sous-dossier"

Mais si ce sous-dossier existe déjà, un message d'erreur s'affiche.

Alors avant de créer ce sous-dossier, il convient de tester s'il existe déjà. Pour cela voici une p'tite fonction :

Function Exist_Rep(Rep As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(Rep) And vbDirectory
End Function

Ce qui permet d'écrire :

Dim Dossier as String
    Dossier= "C:\Users\pierrep\Documents\Exemple_sous-dossier"
    If Not Exist_Rep(Dossier) Then MkDir Dossier

Et si on souhaite créer les dossiers à partir du chemin du fichier excel utilisé, il suffit d'écrire :

Dossier = ThisWorkbook.Path & "\Exemple_sous-dossier"

Avec ça on peut créer ce qu'on veut comme arborescence.

Pierre

Salut à tous,

Petit bout de code qu'il faudra surement adapter, je n'ai pas tester mais cela donne les grosses lignes.

' // Quelques variables
Dim strTemp As String, strFolderName As String, strPath As String

strTemp = "10 01 2021_Chambre.xls"        ' // Juste pour le test il faut adapter
strPath = ThisWorkbook.Path & "\"     ' // Peut-être à adapter
strFolderName = MonthName(Month(CDate(Left(strTemp, 10))), True)        ' // On récupère le mois en abrégé depuis la date

    ' // On teste si le dossier existe sinon on le crée
    If Dir(strPath & strFolderName) <> "" Then MkDir strPath & strFolderName

    ' // On copie le fichier dans le dossier de destination
    Name strPath & strTemp _
         As strPath & strFolder & "\" & strTemp

    Select Case MsgBox("Le fichier a été copié dans le répertoire : " & strPath & strFolder & "\" & strTemp & vbCrLf _
                     & "Il va maintenant être supprimé du répertoire source." & vbCrLf _
                     & "" & vbCrLf _
                     & "Voulez-vous continuer ?", vbYesNo Or vbExclamation, "Copie de fichier")

        Case vbYes
            ' // peut-être fermeture et suppression du fichier
        Case vbNo
            ' // Peut-être message de confirmation
    End Select

Bonjour Pierre et Jean Paul,

1) J'ai testé ce que Pierre a fait et cela marche.

2) Ce que Jean Paul vient de faire, je vais le tester. Il correspond bien à ce que je souhaite faire.

En tout cas, je vous remercie messieurs et vous souhaite un bon après-midi

Juju