Création dossier par VBA

Version imprimable

10/12/2010, 12h36
Djromé

Création dossier par VBA

Salut les Kracks,

Je souhaiterai faire des sauvegardes automatiques d'un dossier excel qui viendraient automatiquement se sauver dans un file nommée : DEC2010 (mois en cours) et ainsi de suite...
Est-ce possible de créer un dossier sur un drive fixe (R:\Dossier\) indiqué par la macro sachant que ce dernier devrait changer chaque mois ou faut-il créer un batch?:calim2:

Code:

ActiveWorkbook.SaveAs "R:\Dossier\Moisencourtannéeencours\Mondossier.xls

D'avance merci
10/12/2010, 12h45
pgz

Bonjour.

Au moment de faire la sauvegarde, tu peux vérifier si le dossier du mois existe et, si non, le créer.
Pour cela voir en FAQ (c'est la même question que la discussion de carlux)

Cordialement,

PGZ

Code:

1
2
3
4
Dim Doss As String
 
Doss = "C:\Documents and Settings\Administrateur\Bureau\TEST"
If Dir(Doss, vbDirectory) = "" Then MkDir Doss

10/12/2010, 13h35
Djromé

Salut Mercatog,

Merci encore!

Salut,une autre manière d'y parvenir sans les problemes de MkDir

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
' Pour valeur retournée dans Rep
' Voir http://msdn.microsoft.com/en-us/library/bb762131(VS.85).aspx
' et   http://msdn.microsoft.com/en-us/library/ms681381(VS.85).aspx
Private Sub CreationDossier(sDos As String)
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDos, 0&)
End Sub
 
Sub Test()
Dim sDossier As String
    sDossier = "C:\repA\repB\repC\repD\repE\repF"
    CreationDossier sDossier
End Sub

Salut les Kracks,

Mon code finale pour créer un dossier sous le format DEC2010:

Code:

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
Option Explicit
 
Sub Dossier()
 
'Faire apparaitre les 3 premieres lettres des mois en cours (idem en anglais)
 
'Partie de code pour ajouter la creation de dossier automatique si inexistant et au format 2010DEC
 
Dim Doss As String
 
Dim Drive As String
 
Dim x ' variable des mois
 
Dim y ' variable des annees
 
Drive = "C:\Test\"
 
x = UCase(Left(Format(Date, "mmmm"), 3)) 'affiche les 3 premiers caracteres en majuscule du mois en cours
 
y = UCase(Format(Date, "YYYY")) 'affiche l'annee en cours
 
Doss = x & y
 
If Dir(Drive & Doss, vbDirectory) = "" Then MkDir Drive & Doss
 
MsgBox ("Le dossier " & x & y & " a ete cree")
 
End Sub

Merci à tous pour votre aide :ccool:

Tu pouvais simplifier comme ceci

Code:

1
2
3
4
5
6
7
8
9
Sub Dossier()
Dim Doss As String
 
Doss = "C:\Test\" & UCase(Format(Date, "mmmyyyy"))
If Dir(Doss, vbDirectory) = "" Then
     MkDir Doss
     MsgBox "Le dossier " & Doss & " a été crée"
End If
End Sub