A common problem with Word documents is that people include bitmap images. This can mean that a page with a small amount of text that ought to be no more than a few kilobytes actually takes up megabytes of space.

You can try and persuade people not to do this but sometimes it's easier to just compress the files for them.

Fortunately, Microsoft make this easy - Office 2007 introduced the .docx format which essentially zips up the document. If it has a bitmap in it, this will normally make the file much, much smaller.

Even if users are working with Office 2003 or Office XP they'll still be able to edit the files as long as they have the file format converters installed - you can push these out with WSUS if that's not already been done.

The script below will trawl through a directory tree and check for .doc files greater than a certain size and older than a given date. If it finds them, it opens the file in Word, resaves it as .docx and once that's safely done, deletes the original file.

'this is the folder to process
sFolder="T:\PDSU"
'files newer than this number of days won't be changed
iDays=30


dim oWord
Const wdFormatDocumentDefault             = 16
Const Megabyte=1000000
set oFSO=createobject("scripting.filesystemobject")
ProcessFolder sFolder

Sub Processfolder(sFolder)
 wscript.echo sFolder
 set oFolder=ofso.getfolder(sFolder)
 set oTopFolder=oFolder.parentfolder
 sTopFolder=oTopFolder.path
 for each oFile in oFolder.files
   if oFile.size > 2 * Megabyte then
     if datediff("d",oFile.datelastmodified,now)>iDays then
       if ucase(ofso.GetExtensionName(oFile))="DOC" then
         sBase=oFSO.GetBaseName(oFile)
         Doc2DocX sFolder,sBase
       end if
     end if
   end if
 next
 for each oSubFolder in oFolder.subfolders
   ProcessFolder sFolder & "\" & oSubFolder.name
 next
end sub

Sub Doc2DocX( sFolder, sFile )
 ' Build the fully qualified DOCX file name
 sOutputFile = sFolder & "\" & sFile & ".docx"
 sInputFile  = sFolder & "\" & sFile & ".doc"
 ' Create a Word object
 Set oWord = CreateObject( "Word.Application" )
 With oWord
   ' True: make Word visible; False: invisible - makes it faster becaus no screen redraw
   .Visible = false
   ' Open the Word document
   .Documents.Open sInputFile
   ' Make the opened file the active document
   Set oDoc = .ActiveDocument
   ' Save as DOCX
   oDoc.SaveAs sOutputFile, wdFormatDocumentDefault
   wscript.echo sOutputFile
   ' Close the active document
   oDoc.Close
   'quit Word
   .quit
 End With
 if ofso.fileexists(sOutputFile) then
   wscript.sleep 1000 'wait for Word to close
   ofso.deletefile sInputFile,true
 end if
End Sub