vbScript - Migrate Collections from SMS to SCCM

This script will migrate all collections from on site sms/sccm to another one
Be careful: Never run the script in your production until you've tested it!!!

Option Explicit
'On Error Resume Next
Dim strSourceServer : strSourceServer = "SMSServer"
Dim strTargetServer : strTargetServer = "SCCMServer"
Dim strSourceSiteCode : strSourceSiteCode = "000"
Dim strTargetSiteCode : strTargetSiteCode = "000"
dim intRuleCounter : intRuleCounter = 0
dim strRuleName(100)
Dim strRuleQuery(100)
Dim strLimitToColl(100)
Dim strCollectionRefType
Dim strCollectionRefShd
Dim Token, schedule, schedtype
Dim bolScheduleAvailable : bolScheduleAvailable = False
Dim objSourceWMIService, objTargetWMIService
Dim AllCollections, objCollection
Dim strCollectionName, strCollectionComment
Dim AllParentCollections, objParentCollections, strParentCollectionName, strNewParentCollectionID
Dim objRules, RuleSet
Dim bolLimitCollExisting : bolLimitCollExisting = False
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.CreateTextFile("MigrateCollections.log")

Set objSourceWMIService = GetObject("winmgmts://" & strSourceServer & "\root\sms\site_" & strSourceSiteCode)
Set objTargetWMIService = GetObject("winmgmts://" & strTargetServer & "\root\sms\site_" & strTargetSiteCode)

objLogFile.WriteLine Now &" - Migrating Collections from " &strSourceServer &" to " &strTargetServer

'Loop trought all collections exsisting on the source server
Set AllCollections = objSourceWMIService.ExecQuery("SELECT * FROM SMS_Collection WHERE NAME NOT LIKE 'All%' AND NAME NOT LIKE 'Root%'") 
For Each objCollection In AllCollections
 strCollectionName = objCollection.Name
 strCollectionComment = objCollection.Comment
 
 objLogFile.WriteLine Now &" - Now migrating the Collection  " &objCollection.Name

 Set objCollection = objSourceWMIService.Get("SMS_Collection='" & objCollection.CollectionID & "'" ) 
 
 'Get Collection schedule
 On Error Resume Next
 Set schedule=objCollection.RefreshSchedule(0)
 On Error GoTo 0
 
 If err.number = 424 Then
     objLogFile.WriteLine Now &" - Collection has no Schedule  " &objCollection.Name
 ElseIf err.number <> 0 Then
  objLogFile.WriteLine Now &" - An Error (" &err.number  &") occured while getting the Update Schedule from " &objCollection.Name
 Else
  On Error Resume Next
  schedtype=Schedule.Path_.Class
  
  Select Case (schedtype)
   Case "SMS_ST_RecurInterval"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurInterval").SpawnInstance_()
     If schedule.MinuteSpan <> 0 Then Token.MinuteSpan = schedule.MinuteSpan
     If schedule.HourSpan <> 0 Then Token.HourSpan = schedule.HourSpan
     If schedule.DaySpan <> 0 Then Token.DaySpan = schedule.DaySpan
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurInterval Schedule available " &objCollection.Name
     
   Case "SMS_ST_RecurWeekly"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurWeekly").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfWeeks <> 0 Then Token.ForNumberOfWeeks = schedule.ForNumberOfWeeks
     If schedule.Day <> 0 Then Token.Day = schedule.Day
     Token.StartTime = schedule.StartTime
     
     bolScheduleAvailable = True
     objLogFile.WriteLine Now &" - SMS_ST_RecurWeekly Schedule available " &objCollection.Name
     
   Case "SMS_ST_RecurMonthlyByDate"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByDate").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.MonthDay <> 0 Then Token.MonthDay = schedule.MonthDay
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByDate Schedule available " &objCollection.Name
    
   Case "SMS_ST_RecurMonthlyByWeekday"
     Set Token = objTargetWMIService.Get("SMS_ST_RecurMonthlyByWeekday").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     If schedule.ForNumberOfMonths <> 0 Then Token.ForNumberOfMonths = schedule.ForNumberOfMonths
     If schedule.WeekOrder <> 0 Then Token.WeekOrder = schedule.WeekOrder

     Token.StartTime = schedule.StartTime
    objLogFile.WriteLine Now &" - SMS_ST_RecurMonthlyByWeekday Schedule available " &objCollection.Name
     
    bolScheduleAvailable = True

   Case "SMS_ST_NonRecurring"
     Set Token = objTargetWMIService.Get("SMS_ST_NonRecurring").SpawnInstance_()
     If schedule.MinuteDuration <> 0 Then Token.MinuteDuration = schedule.MinuteDuration
     If schedule.HourDuration <> 0 Then Token.HourDuration = schedule.HourDuration
     If schedule.DayDuration <> 0 Then Token.DayDuration = schedule.DayDuration
     Token.StartTime = schedule.StartTime
     
    bolScheduleAvailable = True
    objLogFile.WriteLine Now &" - SMS_ST_NonRecurring Schedule available " &objCollection.Name
     
    Case Else
    bolScheduleAvailable = False
    objLogFile.WriteLine Now &" - Unknown Schedule (skipping) " &objCollection.Name
  End Select
     
   End If
 
 'Get Collection Rules
  If Not IsNull(objCollection.CollectionRules) Then
   objRules = objCollection.CollectionRules

   For Each RuleSet In objRules
    intRuleCounter = intRuleCounter + 1
    strRuleName(intRuleCounter) = RuleSet.Rulename
    strRuleQuery(intRuleCounter) = RuleSet.QueryExpression
    If RuleSet.LimitToCollectionID <> "" Then
      strLimitToColl(intRuleCounter) = LimitColID
    End If

    objLogFile.WriteLine Now &" - Collection Rule will be migrated " &strRuleName(intRuleCounter)
   Next
  Else
   'WScript.Echo "Collection without Rules: " &strCollectionName
   set strRuleName(0) = Nothing
   Set strRuleName(0) = Nothing
   intRuleCounter = 0
    objLogFile.WriteLine Now &" - No Collection Rule available"
  End If
 
 
  'Get Parent Collection
 Set AllParentCollections = objSourceWMIService.ExecQuery("SELECT parentCollectionID FROM SMS_CollectToSubCollect WHERE subCollectionID = '" &objCollection.CollectionID &"'")
 For Each objParentCollections In AllParentCollections
  'Determine the parent collections name
  strParentCollectionName = GetParentCollectionName(objParentCollections.parentCollectionID)
  objLogFile.WriteLine Now &" - Parent Collections name is " &strParentCollectionName
  
  'Determine the parent collections id on the target server
  strNewParentCollectionID = GetNewParentCollectionID(strParentCollectionName)
  objLogFile.WriteLine Now &" - New Parent Collections ID is " &strNewParentCollectionID
 Next

 'Create the new collection
 Call CreateCollection(strCollectionName, strCollectionComment, strNewParentCollectionID)
 
Next


Function GetParentCollectionName(CollectionID)
 
Set AllParentCollections = objSourceWMIService.ExecQuery("SELECT Name FROM SMS_Collection WHERE CollectionID = '" &CollectionID &"'")

For Each objParentCollections In AllParentCollections
 GetParentCollectionName = objParentCollections.Name
Next

End Function

Function GetNewParentCollectionID(CollectionName)
 
Set AllParentCollections = objTargetWMIService.ExecQuery("SELECT CollectionID FROM SMS_Collection WHERE Name = '" &CollectionName &"'")
For Each objParentCollections In AllParentCollections
 GetNewParentCollectionID = objParentCollections.CollectionID
Next

End Function

Function CreateCollection(CollectionName, CollectionComment, ParentCollectionID)

Dim newCollection
Dim collectionPath
Dim newSubCollectToSubCollect
Dim queryRule, newQueryRule
Dim newCollectionRule
Dim i

' Create the collection.
Set newCollection = objTargetWMIService.Get("SMS_Collection").SpawnInstance_
newCollection.Comment = CollectionComment
newCollection.Name = CollectionName
newCollection.OwnedByThisSite = True
objLogFile.WriteLine Now &" - Collection created " &CollectionName

'Create Update Schedule for Collection
If bolScheduleAvailable = True Then
 newCollection.RefreshSchedule = Array(Token)
 newCollection.RefreshType = 2
End If
objLogFile.WriteLine Now &" - Configured Collection Schedule " &CollectionName
 
Set collectionPath = newCollection.Put_    
    
'Set Parent Collection
Set newSubCollectToSubCollect = objTargetWMIService.Get("SMS_CollectToSubCollect").SpawnInstance_
newSubCollectToSubCollect.parentCollectionID = ParentCollectionID
newSubCollectToSubCollect.subCollectionID = CStr(collectionPath.Keys("CollectionID"))
newSubCollectToSubCollect.Put_
objLogFile.WriteLine Now &" - Configured th Parent Collection " &CollectionName

'Create Query Memebership Rule
Set queryRule = objTargetWMIService.Get("SMS_CollectionRuleQuery")
Set newCollection = objTargetWMIService.Get(collectionPath.RelPath)
        
For i = 1 To intRuleCounter
 'Create the query rule.
 Set newQueryRule = QueryRule.SpawnInstance_
 newQueryRule.QueryExpression = strRuleQuery(i)
 newQueryRule.RuleName = strRuleName(i)
 If strLimitToColl(i) <> "" Then newQueryRule.LimitToCollectionID = strLimitToColl(i)
 'Add the new query rule to a variable.
 Set newCollectionRule = newQueryRule
 'Add the rules to the collection.
 newCollection.AddMembershipRule newCollectionRule
Next
objLogFile.WriteLine Now &" - Added Collection Rules " &CollectionName
  
'Call RequestRefresh to initiate the collection evaluator.
newCollection.RequestRefresh False

'Clean Variables
On Error Resume Next
Set Token = Nothing
Set schedule = Nothing
Set newCollection = Nothing
bolScheduleAvailable = False
schedtype = ""
intRuleCounter = 0
On Error GoTo 0

End Function
objLogFile.WriteLine Now &" - Finish"
WScript.Echo "Done"