Discussion :

[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.

[hackoofr]

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]

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]

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]

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]

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