Dim NumDrives, FSO, Drives, Count
 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set Drives = FSO.Drives 
 
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
 
For Each Drive in Drives 
If Drive.DriveType = DriveTypeFixed then NumDrives = NumDrives + 1 
Next 
 
Set Drives = Nothing 
Set FSO = Nothing 
 
set WshShell = CreateObject("WScript.Shell")
WshShell.Run "dfrg.msc"
WScript.Sleep 2000
While WshShell.AppActivate("Disk Defragmenter") = FALSE
wscript.sleep 1000
WshShell.AppActivate "Disk Defragmenter"
Wend
 
do while (Count <= NumDrives)
 
wscript.sleep 300
WshShell.SendKeys "%A"
wscript.sleep 300
WshShell.SendKeys "D"
 
While WshShell.AppActivate("Defragmentation Complete") = FALSE
wscript.sleep 5000
Wend
 
WshShell.AppActivate "Defragmentation Complete"
wscript.sleep 300
WshShell.Sendkeys "{RIGHT}"
wscript.sleep 300
WshShell.SendKeys "{ENTER}"
wscript.sleep 500
WshShell.SendKeys "{TAB}"
wscript.sleep 500
WshShell.Sendkeys "{DOWN}"
 
Count = Count + 1
 
loop
 
WshShell.Sendkeys "%{F4}"