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

Version imprimable

Voir 40 message(s) de cette discussion en une page

06/02/2015, 13h53
hadrien2811

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

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.
06/02/2015, 14h07
hackoofr

Citation:

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.

:salut:
Et ceci dans quelle but exactement ? pour faire des sauvegardes mensuels ou autre chose ?
06/02/2015, 14h32
hadrien2811

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.

:salut:
Si ça marche bien, alors, n'oubliez pas mon +1 :plusser: :king: :mouarf: et de passer la discussion en :resolu:

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
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
'*******************************************************************************************************

Merci Hackoofr mais je pense que tu as fait un truc bien trop compliqué à mes yeux. Voila actuellement mon code
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 '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).

Bonjour,

Une piste pour savoir les fichiers d'un dossier :

Code:

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:

ListeFichier("C:\Modele")

par exemple.

Pour copier les fichiers vers C:\Test :

Code:

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

09/02/2015, 15h41
hadrien2811

Merci Miistik mais j'arrive juste pas à savoir à quoi corresponds tes variables "Fichier" ainsi que Folder.files
09/02/2015, 16h32
hadrien2811

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

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

Code:

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\

09/02/2015, 20h03
hadrien2811

franchement tu es très sympa mais je vois pas où tu déclare la variable Fichier
09/02/2015, 22h43
ProgElecT

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.

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:

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

Bonjour,

Voici ton code modifié :

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
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:

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

par

Code:

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

10/02/2015, 11h36
hadrien2811

merci pour le code modifié. J'ai juste une erreur Objet requis : 'fso'
10/02/2015, 11h40
Miistik

Remplaces fso par fs
10/02/2015, 11h45
hadrien2811

ç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'
10/02/2015, 11h48
Miistik

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

Ce n'est pas

Code:

Fichier.GetExtensionName(Fichier.Path)

mais

Code:

fs.GetExtensionName(Fichier.Path)

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:

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

10/02/2015, 12h06
Miistik

Tes fichiers Excel ont bien l'extension xls ?

Sinon cela ne fonctionne pas (extension excel possible : xls, xlsx, xlsm ...)
10/02/2015, 12h08
hadrien2811

non ils ont l'extension xlsx mais meme en changeant "xls" par "xlsx" ca ne marche pas

Voir 40 message(s) de cette discussion en une page