VBS Script to Find all Outlook pst files on C and D Drives

This script will find all the pst files on a computers C and D drive (if there is a D). It will create a folder in the root of C called pstlog and save in it the results file with the name pst_files_on_computername . Each pst file found will show its location, name and size. Depending on how many drives and there sizes this scriipt can take up to 10 minutes to complete. Be patient

 'Find all Outlook pst files on C and D Drives  
 strComputer = "."  
 on error resume next  
 set wshnetwork=createobject("wscript.network")  
 scomputername=wshnetwork.computername  
 set wshnetwork=nothing  
 Const OverwriteExisting = True  
 Set objWMIService = GetObject("winmgmts:\" & strComputer & "rootcimv2")  
 Set colFiles = objWMIService.ExecQuery _  
 ("Select * from CIM_DataFile Where Extension = 'pst' AND (Drive = 'C:' OR Drive = 'D:')")  
 If colFiles.Count = 0 Then  
 Wscript.Quit  
 End If  
 Set objFSO = CreateObject("Scripting.FileSystemObject")  
 Set objFolder = objFSO.CreateFolder("C:pstlog")  
 Set objTextFile = objFSO.CreateTextFile("c:pstlogpst_files_on_" & scomputername & ".txt " , True)  
 For Each objFile in colFiles  
 objTextFile.Write(objFile.Drive & objFile.Path & "")  
 objTextFile.Write(objFile.FileName & "." & objFile.Extension & ", Size ")  
 objTextFile.Write(objFile.FileSize /1024 & "kb" & vbCrLf)  
 Next  
 objTextFile.Close