VBS Creer un dossier avec la date du jour et y ajouté des fichiers à l'interieurs

**hadrien2811** · 06/02/2015, 13h53

Bonjour,

Etant débutant en VBS, j'essaye depuis plusieurs jours à réaliser un script permettant de créer, tous les mois, un dossier avec la date du jour et d'y ajouter à l'intérieur de ce dossier des fichier qui viennent d'un autre répertoire.

Je sais qu'il faut créer une boucle mais je ne sais pas laquelle utiliser.

Si vous avez des idées, je suis preneur.

Merci de votre aide.

**hackoofr** · 06/02/2015, 14h07

Envoyé par hadrien2811

Bonjour,

Etant débutant en VBS, j'essaye depuis plusieurs jours à réaliser un script permettant de créer, tous les mois, un dossier avec la date du jour et d'y ajouter à l'intérieur de ce dossier des fichier qui viennent d'un autre répertoire.

Je sais qu'il faut créer une boucle mais je ne sais pas laquelle utiliser.

Si vous avez des idées, je suis preneur.

Merci de votre aide.

Et ceci dans quelle but exactement ? pour faire des sauvegardes mensuels ou autre chose ?

**hadrien2811** · 06/02/2015, 14h32

salut hackoofr

Pour etre plus precis, il s'agit de copier des fichiers excel, qui sont actuellement dans un dossier "Modele", et de les ranger dans un dossier que je dois créer chaque mois. Le dossier créé doit alors avoir comme nom l'année et le mois en cours. Chaque mois, je dois compléter ces fichiers et donc c'est pour cela que je voudrais automatiser la tache.

**hackoofr** · 07/02/2015, 04h25

Si ça marche bien, alors, n'oubliez pas mon +1

et de passer la discussion en

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit
Dim Source,Destination
Source = "C:\Modele"
Destination = "C:\"& Month(Now) & "_" & Year(Now)
If AppPrevInstance() Then   
    MsgBox "Il y a une instance déjà en cours !"& VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,"Il y a une instance déjà en cours !"    
    WScript.Quit   
Else 
    Call CopyDirs(Source,Destination)
    MsgBox "La copie est terminée !",vbInformation,"La copie est terminée !"
End If
'*************************************************************************************************
Sub CopyDirs(fromFolder,toFolder)
    Dim oFSO,c_folder,c_File,subFolder
    Set oFSO = CreateObject("Scripting.FileSystemObject")
 
    If Not(oFSO.FolderExists(fromFolder)) Then
        MsgBox "ATTENTION le dossier " & DblQuote(fromFolder) & " n'existe pas !",vbExclamation,_
        "ATTENTION le dossier " & DblQuote(fromFolder) & " n'existe pas !"
        Wscript.Quit
    End if
 
    Set c_folder = oFSO.GetFolder(fromFolder)
    On Error Resume Next
    If Not(oFSO.FolderExists(toFolder)) Then
        oFSO.CreateFolder toFolder
        If Err <> 0 Then
            MsgBox Err.Description & Vbcr &_
            "Le chemin du " & DblQuote(toFolder) &" est introuvable !" ,VbCritical,Err.Description
            Wscript.Quit
        End if    
    End If
 
    For Each c_File In c_folder.Files
        If Not(oFSO.FileExists(toFolder & "\" & c_File.Name)) Then
            oFSO.CopyFile c_folder.Path & "\" & c_File.Name,toFolder & "\" & c_File.Name
        End If
    Next
 
    For Each subFolder In c_folder.SubFolders
        If Not( oFSO.FolderExists(toFolder & "\" & subFolder.Name)) Then
            oFSO.CreateFolder toFolder & "\" & subFolder.Name
        End If
'Appel récursive de la procèdure CopyDirs() 
        Call CopyDirs(subFolder.Path,toFolder & "\" & subFolder.Name)
    Next
End Sub
'*****************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'******************************************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function   
'*******************************************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'*******************************************************************************************************

**hadrien2811** · 09/02/2015, 09h57

Merci Hackoofr mais je pense que tu as fait un truc bien trop compliqué à mes yeux. Voila actuellement mon code

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
 
 
'Déclaration des variables
Dim Date_Mois, Date_Annee, FSCopie1, Date1
 
'Formatage de la date
Date_Mois = date
Date_Mois = month(Date_Mois) 
 
Date_Annee = date
Date_Annee = year(Date_Annee)
 
Date1 = Date_Annee & Date_Mois
 
'Création de dossiers
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateFolder ("C:\Test\" & Date_Annee & Date_Mois)
 
If (fs.FolderExists("C:\Test\" & Date_Annee & Date_Mois)) then 
 
'Copie du fichier
Set FSCopie1 = CreateObject("Scripting.FileSystemObject")
FSCopie1.CopyFile "C:\Modele\toto" , "C:\Test\"&Date1&"\toto_" & Date_Annee & "-" & Date_Mois & ".xlsx"
 
End If

Le problème c'est que, de un, mon code est moche et, de 2, il fait bêtement la copie du fichier "toto". Il se peut que le dossier toto disparaisse ou que celui ci soit remplacé par un autre. Du coup, j'essaye de trouver une fonction tableau qui liste l'ensemble du répertoire Modele et qui copie l'ensemble vers C:\Test car en vérité dans le dossier Modele il y a environ 200 fichiers (parfois j'en rajoute parfois j'en supprime).

**Miistik** · 09/02/2015, 13h55

Bonjour,

Une piste pour savoir les fichiers d'un dossier :

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
'FONCTION LISTANT LES FICHIERS D'UN DOSSIER
'ENTREE : FolderPath : chemin d'un dossier
Private Sub ListeFichier(FolderPath) 
 
'On capte le dossier passé en paramètre
Set Folder = fso.Getfolder(FolderPath) 
 
'Ouverture du fichier pour stocker les correspondances avec les motifs
'Path_ListeFile est un chemin d'un fichier .txt
Set OutPut = fso.OpenTextFile(Path_ListeFile,ForWriting,True)  '8 si on veut pas écrasé
 
'Test des fichiers dans le dossier
For Each Fichier In Folder.Files
	If (fso.GetExtensionName(Fichier.Path) = "xls") Then 'si fichier Excel		
	         OutPut.WriteLine (Fichier.Name)
	End If
Next
 
OutPut.Close 
End Sub

Ainsi tu auras un fichier avec la liste de tous les fichiers d'un dossier.
Pour utiliser le sub, tu fais

Code :

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

ListeFichier("C:\Modele")

par exemple.

Pour copier les fichiers vers C:\Test :

Code :

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

1
2
3
4
5
6
Set Folder = fso.Getfolder(FolderPath)
For Each Fichier In Folder.Files
	If (fso.GetExtensionName(Fichier.Path) = "xls") Then 'si fichier Excel		
                            fso.CopyFile "c:\Modele\" & GetFileName(Fichier), "c:\Test\"
	End If
Next

**hadrien2811** · 09/02/2015, 15h41

Merci Miistik mais j'arrive juste pas à savoir à quoi corresponds tes variables "Fichier" ainsi que Folder.files

**hadrien2811** · 09/02/2015, 16h32

Au passage désolé je suis vraiment nul en développement

**Miistik** · 09/02/2015, 16h40

Je pourrais te laisser chercher sur Internet mais je suis gentil.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
'On attrape le dossier 
'FolderPath est le nom de ton dossier (C:\Modele par exemple)
Set Folder = fso.Getfolder(FolderPath)
 
'Pour chaque fichier dans ton dossier
'Folder.Files permet d'avoir la liste des fichiers dans Folder (Folder correspond à la première ligne de code)
For Each Fichier In Folder.Files
	If (fso.GetExtensionName(Fichier.Path) = "xls") Then 'si fichier Excel	
                             'On copie les fichiers excel vers C:\Test\
                             'GetFileName permet de récupérer le nom du fichier	
                            fso.CopyFile "c:\Modele\" & GetFileName(Fichier), "c:\Test\" 
	End If
Next

En gros, ce code parcourt un dossier et copie tous les fichiers excel (extension .xls) vers C:\Test\

**hadrien2811** · 09/02/2015, 20h03

franchement tu es très sympa mais je vois pas où tu déclare la variable Fichier

**ProgElecT** · 09/02/2015, 22h43

Salut
Si la première ligne du code n'est pas Option Explicit, il n'est pas obligatoire de déclarer une variable (mais très mauvaise habitude).

Dans la boucle For Each Fichier In Folder.Files ..... Next, Fichier va prendre la valeur objet de chaque fichier contenu dans le dossier Folder, Folder.Files étant la collection des fichiers du dossier.

**hadrien2811** · 10/02/2015, 10h04

meme en travaillant dessus, mon code ne marche toujours pas et je ne vois pas quoi modifier. J'ai bien la création du dossier mais impossible de faire la copie de c:\Modele vers C:\Test

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
 
'Déclaration des variables
Dim Date_Mois, Date_Annee, FSCopie1
Dim Date1
 
'Formatage de la date
Date_Mois = date
Date_Mois = month(Date_Mois) 
 
Date_Annee = date
Date_Annee = year(Date_Annee)
 
Date1 = Date_Annee & Date_Mois
 
'Création de dossiers
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateFolder ("C:\Test\" & Date1)
 
 
Set Folder = fso.Getfolder("C:\Modele")
 
 
 
For Each Fichier In Folder.Files
 
	If (Fichier.GetExtensionName(Fichier.Path) = ".xls") Then 	
                             'On copie les fichiers excel vers C:\
 
			     'GetFileName permet de récupérer le nom du fichier	
                            fso.CopyFile "C:\Modele\" & GetFileName(Fichier), "C:\Test" 
	End If
 
 
 
Next

**Miistik** · 10/02/2015, 11h19

Bonjour,

Voici ton code modifié :

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
 
'Déclaration des variables
Dim Date_Mois, Date_Annee, FSCopie1
Dim Date1
 
'Formatage de la date
Date_Mois = date
Date_Mois = month(Date_Mois) 
 
Date_Annee = date
Date_Annee = year(Date_Annee)
 
Date1 = Date_Annee & Date_Mois
 
'Création de dossiers
Set fs = CreateObject("Scripting.FileSystemObject")
 
'TON DOSSIER DE DESTINATION
fs.CreateFolder ("C:\Test\" & Date1) 
 
Set Folder = fso.Getfolder("C:\Modele\") 'ATTENTION AU \
 
 
 
For Each Fichier In Folder.Files
 
	If (Fichier.GetExtensionName(Fichier.Path) = ".xls") Then 	
                             'On copie les fichiers excel vers C:\
 
			     'GetFileName permet de récupérer le nom du fichier	
                            'ATTENTION AU \ et au dossier de Destination 
                            fso.CopyFile "C:\Modele\" & GetFileName(Fichier), "C:\Test\" & Date1 & "\" 
	End If
 
 
 
Next

Ceci devrait fonctionner.

PS : Tu peux remplacer

Code :

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

fso.CopyFile "C:\Modele\" & GetFileName(Fichier), "C:\Test\" & Date1 & "\"

par

Code :

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

fso.CopyFile Fichier.Path,"C:\Test\" & Date1 & "\"

**hadrien2811** · 10/02/2015, 11h36

merci pour le code modifié. J'ai juste une erreur Objet requis : 'fso'

**Miistik** · 10/02/2015, 11h40

Remplaces fso par fs

**hadrien2811** · 10/02/2015, 11h45

ça ne marche toujours pas. cette fois ci l'erreur est : cet objet ne gère pas cette propriété ou cette méthode 'Fichier.getExtensionName'

**Miistik** · 10/02/2015, 11h48

Bah oui, tu as modifié mon script .... (entre le message 9 et le 12)

Ce n'est pas

Code :

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

Fichier.GetExtensionName(Fichier.Path)

mais

Code :

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

fs.GetExtensionName(Fichier.Path)

**hadrien2811** · 10/02/2015, 11h55

lol je crois que j'arriverais jamais à faire ce que je veux. j'ai aucun message d'erreur mais la copie des fichiers Excel ne se fait pas.

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
 
'Déclaration des variables
Dim Date_Mois, Date_Annee, FSCopie1
Dim Date1
 
'Formatage de la date
Date_Mois = date
Date_Mois = month(Date_Mois) 
 
Date_Annee = date
Date_Annee = year(Date_Annee)
 
Date1 = Date_Annee & Date_Mois
 
'Création de dossiers
Set fs = CreateObject("Scripting.FileSystemObject")
 
'TON DOSSIER DE DESTINATION
fs.CreateFolder ("C:\Test\" & Date1) 
 
Set Folder = fs.Getfolder("C:\Modele\") 'ATTENTION AU \
 
 
 
For Each Fichier In Folder.Files
 
	If (fs.GetExtensionName(Fichier.Path) = ".xls") Then 	
                             'On copie les fichiers excel vers C:\
 
			     'GetFileName permet de récupérer le nom du fichier	
                            'ATTENTION AU \ et au dossier de Destination 
                            fs.CopyFile Fichier.Path,"C:\Test\" & Date1 & "\""
	End If
 
 
 
Next