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
| Option Explicit
Dim fso, x, col, lect, F, drv, Ext
Set fso=createobject("Scripting.FileSystemObject")
For Each drv In fso.Drives
If drv.DriveType = 1 Then
If drv.IsReady Then
Set x = fso.GetDrive(drv)
x = drv.DriveLetter
Exit For
Else
x=inputbox("Veuillez entrer la lettre d'un lecteur : " )
If x = "" Or Len(x) > 1 Then
MsgBox "Veuillez réessayer en donnant une unité de lecteur valide"
WScript.Quit
End If
End If
End If
Next
On Error Resume Next ' Juste pour ne pas avoir l'erreur : le fichier(dossier) existe déjà
' si on exécute le code une 2ème fois
fso.CreateFolder(x & ":\VBS")
fso.CreateFolder(x & ":\VBS\Musique")
fso.CreateFolder(x & ":\VBS\Videos")
fso.CreateFolder(x & ":\VBS\Script")
fso.CreateFolder(x & ":\VBS\Images")
fso.CreateFolder(x & ":\VBS\Documents")
fso.CreateFolder(x & ":\VBS\Archives")
fso.CreateFolder(x & ":\VBS\PDF")
fso.CreateFolder(x & ":\VBS\Programmes")
fso.CreateFolder(x & ":\VBS\Autres Fichiers")
Set lect=fso.GetFolder(x & ":\")
Set col=lect.Files
for each F in col
Ext=fso.GetExtensionName(f.name)
Select Case LCase(Ext)
Case "vbs" : F.Move (x & ":\VBS\Script\")
Case "mp3", "wma", "dat", "cda" : F.Move (x & ":\VBS\Musique\")
Case "exe", "com" : F.Move (x & ":\VBS\Programmes\")
Case "jpg", "jpeg", "gif", "bmp" : F.move (x & ":\VBS\Images\")
Case "avi", "mpg", "mpeg", "mp4", "flv" : F.move (x & ":\VBS\Videos\")
Case "txt", "doc", "docx", "ps", "xls","xlsx", "ppt", "pptx" : F.Move (x & ":\VBS\Documents\")
Case "rar", "zip" : F.Move (x & ":\VBS\Archives\")
Case "pdf" : F.Move (x & ":\VBS\PDF\")
Case Else : F.Move (x & ":\VBS\Autres Fichiers\")
End Select
Next |
Partager