Création répertoire en fonction date du document Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
J
Julien_DBS
Jeune membre
Jeune membre
Messages : 42
Inscrit le : 21 juillet 2015
Version d'Excel : 2010

Message par Julien_DBS » 21 juillet 2015, 09:49

Bonjour à tous,
Cela fait plusieurs jours que je cherche sur internet après ce problème mais je ne trouve pas mis à part qu'il faut que j'utilise la fonction MkDir.

J'ai déjà créé un code pour mon fichier mais en plus de ça, je veux que si les répertoires (et sous-répertoires) n'existent pas ils soient créés.

Je m'explique :
- pour le moment le nom du document créé est en fonction de la date mais en plus de ça j'ai envie de classer par mois et par année donc créé un répertoire année + un sous-répertoire mois (si ils n'existent pas) en fonction de la date de création du document (ou de son nom car le nom est en fonction de la création du document).
Public Sub Enregistrer() 'copie sauvegarde classeur
Dim nom As String
    nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
    For n = ActiveSheet.Shapes.Count To 1 Step -1
    If Left(ActiveSheet.Shapes(n).Name, 6) = "Button" Then ActiveSheet.Shapes(n).Delete
  Next n 'Supression du bouton sur la copie
    ActiveWorkbook.SaveCopyAs "D:\Users\FX5180\Desktop\Test\Meyrin" & "\" & nom
    rep = MsgBox("Votre fichier est sauvegardé sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
    Workbooks.Open Filename:="D:\Users\FX5180\Desktop\Test\Meyrin" & "\" & nom 'Ouverture de la copie
    ThisWorkbook.Close SaveChanges:=False 'Fermeture de l'original
End Sub
Je travaille sous Excel 2010 et je suis débutant en VBA donc si vous avez d'autres solutions pour mon code déjà existant je suis preneur.
Merci d'avance pour le temps que vous consacrerez.
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 3'485
Appréciations reçues : 131
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 21 juillet 2015, 11:11

Bonjour Julien, bonjour le forum,

Peut-être comme ça :
Public Sub Enregistrer() 'copie sauvegarde classeur
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim A As String 'déclare la variable A (Année)
Dim M As String 'déclare la variable M (Mois)
Dim NCH As String 'déclare la variable NCH ( Nouveau CHemin d'accès)
Dim nom As String

CH = "D:\Users\FX5180\Desktop\Test\Meyrin\" 'définit le chemin d'accès CH
A = CStr(Year(Date)) 'définit l'année A
M = CStr(Format(Date, "mmmm")) 'définit le mois M
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir CH & A 'change le dossier courant (génère une erreur si ce dossier n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    MkDir CH & A 'crée un nouveau dossier avec l'année en cours
End If 'fin de la condition
ChDir CH & A 'change le dossier courant
ChDir CH & A & "\" & M 'change le dossier courant (génère une erreur si ce dossier n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    MkDir CH & A & "\" & M 'crée un nouveau dossier avec le mois en cours
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
ChDir CH & A & "\" & M 'change le dossier courant
NCH = CH & A & "\" & M & "\" 'définit le nouveau chenim d'accès NCH

nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
For n = ActiveSheet.Shapes.Count To 1 Step -1
    If Left(ActiveSheet.Shapes(n).Name, 6) = "Button" Then ActiveSheet.Shapes(n).Delete
Next n 'Supression du bouton sur la copie
ActiveWorkbook.SaveCopyAs NCH & nom
rep = MsgBox("Votre fichier est sauvegardé sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
Workbooks.Open Filename:=NCH & nom 'Ouverture de la copie
ThisWorkbook.Close SaveChanges:=False 'Fermeture de l'original
End Sub
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
J
Julien_DBS
Jeune membre
Jeune membre
Messages : 42
Inscrit le : 21 juillet 2015
Version d'Excel : 2010

Message par Julien_DBS » 21 juillet 2015, 11:22

Cela fonctionne parfaitement bien.

Je te remercie de ton aide :).
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message