Discussion :

[etorria]

Bonjour au Forum !

Dans un userform, je saisie des données dans des TextBox. On y
renseigne la date du jour, une catégorie et des valeurs.
Ces données sont enregistrées quotidiennement dans un onglet portant
le nom de la date du jour.
Mon souhait serait, à l'aide d'un code VBA, de créer automatiquement
dans C:\ par exemple, un premier répertoire dénommé "MARS" puis un
sous-répertoire dénommé "12-03-2008" (pour la date du jour) et enfin
un autre sous répertoire dénommé "Alpha" (pour la catégorie). Dans ce
dernier seront enregistrées mes données saisies dans l'userform.


Est-ce réalisable sous VBA ou dois-je faire la "manip" manuellement ?


Cordialement,


Etorria

[ML0808]

C'est faisable sous VBA. Tu auras besoins des infos suivante :

MkDir "Chemin/NomDossier" => Créer un dossier
SaveAs "Chemin/NomFichier" => Sauvegarde ton fichier

Ce code te rentre dans la variable ProjectPath le chemin de ton classeur actuel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
' Associe le classeur de recherche au nom RECH
Dim WBK As Workbook
Set WBK = ActiveWorkbook
 
    ' Mémorise le chemin du fichier
    Dim ProjectPath$
    ProjectPath = ActiveWorkbook.Path

Date() => te donne la date

A+

[kiki29]

Soir Bon,à adapter au contexte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Option Explicit
 
Sub TstCreationDossier()
Dim Dossier As String
 
    Dossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    If CreationDossier(Dossier) Then
        MsgBox "Dossier : " & Dossier & " créé"
    Else
        MsgBox "Chemin d'Accès introuvable"
    End If
End Sub
 
Private Function CreationDossier(ByVal sChemin As String) As Boolean
Dim i As Integer, sTmp As String, Ar() As String
    If InStr(sChemin, ":") = 0 Then
        Ar = Split(CurDir & "\" & sChemin, "\")
    Else
        Ar = Split(sChemin, "\")
    End If
 
    sTmp = Ar(0)
    ChDrive sTmp
 
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next i
 
    If Dir(sChemin, vbDirectory) = vbNullString Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function

[ucfoutu]

Bonjour,

Moi, je te propose ceci, à analyser et à adapter à ton appli

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub Command1_Click()
  Dim mois As String, racine As String, fichier As String, repertoire As String
  mois = UCase(Format(Date, "mmmm"))
  ladate = Format(Date, "dd-mm-yyyy")
  repertoire = "D:\" & mois
  If Not deja(repertoire, vbDirectory) Then
    MkDir repertoire
  Else
    alerte repertoire, "répertoire"
  End If
  repertoire = repertoire & "\" & ladate
  If Not deja(repertoire, vbDirectory) Then
    MkDir repertoire
  Else
    alerte repertoire, "répertoire"
  End If
  fichier = repertoire & "\coucou.txt"
  If Not deja(fichier, 0) Then
    '=======>>> ICI  tes instruction de sauvegarde du fichier coucou
  Else
    alerte fichier, "fichier"
  End If
End Sub
 
Private Function deja(acreer As String, att As Integer) As Boolean
  deja = False
  If Dir(acreer, att) <> "" Then deja = True
End Function
 
Private Sub alerte(acreer As String, quoi As String)
  MsgBox "Le " & quoi & " " & acreer & " existe déjà !"
End Sub

[etorria]

Bonjour,

Moi, je te propose ceci, à analyser et à adapter à ton appli

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub Command1_Click()
  Dim mois As String, racine As String, fichier As String, repertoire As String
  mois = UCase(Format(Date, "mmmm"))
  ladate = Format(Date, "dd-mm-yyyy")
  repertoire = "D:\" & mois
  If Not deja(repertoire, vbDirectory) Then
    MkDir repertoire
  Else
    alerte repertoire, "répertoire"
  End If
  repertoire = repertoire & "\" & ladate
  If Not deja(repertoire, vbDirectory) Then
    MkDir repertoire
  Else
    alerte repertoire, "répertoire"
  End If
  fichier = repertoire & "\coucou.txt"
  If Not deja(fichier, 0) Then
    '=======>>> ICI  tes instruction de sauvegarde du fichier coucou
  Else
    alerte fichier, "fichier"
  End If
End Sub
 
Private Function deja(acreer As String, att As Integer) As Boolean
  deja = False
  If Dir(acreer, att) <> "" Then deja = True
End Function
 
Private Sub alerte(acreer As String, quoi As String)
  MsgBox "Le " & quoi & " " & acreer & " existe déjà !"
End Sub

Merci à vous tous !

Etorria

[ucfoutu]

Bon...

Puisque je vois que tu as passé cette première étape...

Nous allons maintenant voir ensemble la puissance et l'agilité de l'Api de Windows, dont la fonction SHCreateDirectoryEx est, elle, capable de ne créer un répertoire QUE S'IL N'EXISTE PAS (et le tout en silence).
Nous n'aurons donc à prendre une précaution (et un message si besoin) que pour le fichier de sauvegarde.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
 (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
Private Sub Command1_Click()
  Dim mois As String, racine As String, fichier As String, repertoire As String, coucou As Long
  mois = UCase(Format(Date, "mmmm"))
  ladate = Format(Date, "dd-mm-yyyy")
  repertoire = "D:\" & mois & "\" & ladate
  fichier = repertoire & "\coucou.txt"
  coucou = SHCreateDirectoryEx(0&, repertoire, 0&)
  If Dir(fichier, 0) = "" Then
     'ici tes instructions de sauvegarde
  Else
    MsgBox "le fichier " & fichier & " existe déjà !"
  End If
End Sub

Important : cette fonction nécessite toutefois Win 2000 ou au dessus.... (mais qui se sert encore de Win 9x ??? )