Autodefrag via a VBScript


Drive defragmentation is not a very exciting subject, however in the past I've had a need to automate drive defragmentation via a scheduled task so I've used the following VB script.  It allows for email notification and varying levels of status messages.

The select \ case section is used to exclude drives that you don't want defrag run against (for whatever reason) and the highlighted sections require change in order to work in your environment, either to set the mail relay, sending server SMTP reply-to address or mail recipient for the reports.

------------------------------------------------------

option Explicit

Set WshNetwork = WScript.CreateObject("WScript.Network")

strServer = WshNetwork.ComputerName

Dim WshNetwork,strServer,oShell,oFSO,ExtPath,clsDrive,colDrives,iReturn,strDefragStat
Set oFSO= CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("WScript.Shell")
Set colDrives = oFSO.Drives

For Each clsDrive in colDrives
  Select Case ClsDrive.DriveLetter
    Case "V"
      'Skip drive V
    Case "W"
      'Skip drive W
    Case Else
      If clsDrive.DriveType = 2 Then '2=Fixed drive
        iReturn = oShell.Run("defrag " & clsDrive & " -f" , 1, TRUE)
  
   Select Case iReturn
     Case 0
       strDefragStat =  clsDrive & " Successfully defragmented."
            Case 1
       strDefragStat =  clsDrive & " Defrag cancelled manually."
            Case 2
              strDefragStat =  clsDrive & " Defrag failed! Command-line error!"
            Case 4
              strDefragStat =  clsDrive & " Defrag Failed! Insufficient memory!"
            Case 6
              strDefragStat =  clsDrive & " Defrag failed! System error!"
            Case 7
              strDefragStat =  clsDrive & " Defrag failed! Insufficient drive space!"
            Case Else
       strDefragStat =  clsDrive & " Defrag failed! Unknown error!"
          End Select
          SendMail system.admin@contoso.com, strServer, strDefragStat
      End If
  End Select
Next

Sub SendMail(strTO, strServer, strDefragStat)

 Dim iMsg
 Dim iConf
 Dim Flds
 Dim strHTML
 Dim strSmartHost

 Const cdoSendUsingPort = 2
 StrSmartHost = "mail.contoso.corp"

 set iMsg = CreateObject("CDO.Message")
 set iConf = CreateObject("CDO.Configuration")

 Set Flds = iConf.Fields

 With Flds
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmartHost
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
 .Update
 End With

 With iMsg
 Set .Configuration = iConf
 .To = strTO
 .From = strServer & "@contoso.com"
 .Subject = strServer & " defrag Status - " & strDefragStat
 .TEXTBody = strDefragStat
 .Send
 End With

 Set iMsg = Nothing
 Set iConf = Nothing
 Set Flds = Nothing

End Sub

Comments (0)

Skip to main content