Time to Round Up Those Scripts

Listing 1: ScriptRoundUp.vbs

Const adPersistXML  = 1
Const adFldIsNullable = 32
Const adLongVarChar = 201

ColPath = "C:\Scripts\AllScripts\"
DestRoot = ColPath & "ScriptFiles"

strQuery = "Select Drive,Extension,Name,Path from CIM_DataFile " & _
  "Where (Drive='c:' OR Drive='d:') AND (extension='vbs' OR extension='hta')"

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(ColPath) Or Not fso.folderExists(DestRoot) Then
  Msgbox "Collection Folder " & ColPath & " or " & DestRoot & " does not exist... Terminating Script"
  WScript.Quit
End If

strMessage = "A message box will appear when process is complete."
strMsgTitle = "Script Round-up"
CreateObject("WScript.Shell").Popup strMessage,10,strMsgTitle,vbInformation

' Begin Callout A
Set objShell = CreateObject("Shell.Application")
Set RootFolder = objShell.NameSpace(DestRoot)
' End Callout A

' Begin Callout B
Set DRS = CreateObject("ADODB.Recordset")
DRS.Fields.Append "Drive",adLongVarChar,256,adFldIsNullable
DRS.Fields.Append "Extension",adLongVarChar,256,adFldIsNullable
DRS.Fields.Append "Name",adLongVarChar,256,adFldIsNullable
DRS.Fields.Append "Path",adLongVarChar,256,adFldIsNullable
DRS.Open
' End Callout B

' Begin Callout C
Set objWMIService = GetObject("winmgmts:" _
  & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colFiles = objWMIService.ExecQuery(strQuery)

For Each objFile In colFiles
  DRS.AddNew
  DRS("Drive") = objFile.Drive
  DRS("Extension") = objFile.Extension
  DRS("Name") = objFile.Name
  DRS("Path") = objFile.Path
Next

DRS.MoveFirst
' End Callout C

' Begin Callout D
Do While Not DRS.EOF
  FolderPath = Replace(DRS.Fields.Item("Drive"),":","") & DRS.Fields.Item("Path")
  Dest = DestRoot & "\" & Replace(DRS.Fields.Item("Drive"),":","") & DRS.Fields.Item("Path")
  If Not fso.FolderExists(Dest) Then
    RootFolder.NewFolder(FolderPath)
  End If
  Set sourcefile = nothing
  Set sourcefile = fso.getFile(DRS.Fields.Item("Name"))
  sourcefile.Copy Dest
  DRS.MoveNext
Loop
' End Callout D

If fso.FileExists(ColPath & "Scripts.xml") Then
  fso.DeleteFile(ColPath & "Scripts.xml")
End If

DRS.Save ColPath & "Scripts.xml",adPersistXML
DRS.Close
MsgBox "Done"