Перемещение файлов из одной папки по разным папкам на VBS

Option Explicit
 
Dim objFSO
Dim strMask
 
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 
With objFSO
    For Each strMask In Array("*Grib*","*p_Trade*","*p_Buh*","*p_Zarplata*" )
         On Error Resume Next
        .MoveFile .BuildPath("D:", strMask), "D:\Griboedov"
         On Error Goto 0
    Next
End With
 
Set objFSO = Nothing
 
WScript.Quit 0

Option Explicit: Dim Arr, oDir1, oDir2, oDir, i, Spl
Arr = Split("Trade| Buh| Zar|plata Griboedov| Glav|")
With CreateObject("Shell.Application")
   Set oDir1 = .NameSpace("D:\Backups BD 1C\Backups SQL 1C 8")
   Set oDir2 = .NameSpace("D:\Backups_Docs")
End With
For i = 0 To UBound(Arr)
   If i < 4 Then If i = 0 Then Set oDir = oDir1 Else If i = 3 Then Set oDir = oDir2
   Spl = Split(Arr(i), "|"): oDir.NewFolder Spl(0) & Spl(1)
   oDir.ParseName(Spl(0) & Spl(1)).GetFolder.MoveHere "D:\test\*" & Spl(0) & "*"
Next
Set oDir = Nothing: Set oDir1 = Nothing: Set oDir2 = Nothing

   If i < 3 Then If i = 0 Then Set oDir = oDir1 Else If i = 2 Then Set oDir = oDir2

oDir.NewFolder Spl(0) & Spl(1)

If i < 3 Then If i = 0 Then Set oDir = oDir1 Else If i = 2 Then Set oDir = oDir2

Option Explicit
Dim ArrX, Arr0, Arr1, Arr2, oShell, oDir, i, c, Spl
ArrX = Array(" BD 1C\Backups SQL 1C 8", "_Docs", " OS")
Arr0 = Split("Trade| Buh| Zar|plata")
Arr1 = Split("Griboedov| Glav|")
Arr2 = Split("OS1| OS2|")
Set oShell = CreateObject("Shell.Application")
For i = 0 To UBound(ArrX)
   Set oDir = oShell.NameSpace("D:\Backups" & ArrX(i))
   Execute "Arr = Arr" & i
   For c = 0 To UBound(Arr)
      Spl = Split(Arr(c), "|"): oDir.NewFolder Spl(0) & Spl(1)
      oDir.ParseName(Spl(0) & Spl(1)).GetFolder.MoveHere "D:\test\*" & Spl(0) & "*"
   Next
Bext
Set oDir = Nothing: Set oShell = Nothing

Option Explicit
Dim ArrX, Arr0, Arr1, Arr2, oShell, oItems, oDir, i, c, Spl
ArrX = Array(" BD 1C\Backups SQL 1C 8", "_Docs", " OS")
Arr0 = Split("Trade| Buh| Zar|plata")
Arr1 = Split("Griboedov| Glav|")
Arr2 = Split("OS1| OS2|")
Set oShell = CreateObject("Shell.Application")
Set oItems = oShell.NameSpace("D:\test").Items
For i = 0 To UBound(ArrX)
   Set oDir = oShell.NameSpace("D:\Backups" & ArrX(i))
   Execute "Arr = Arr" & i
   For c = 0 To UBound(Arr)
      Spl = Split(Arr(c), "|")
      oItems.Filter 73920, "*" & Spl(0) & "*"
      If oItems.Count Then oDir.NewFolder Spl(0) & Spl(1) :_
      oDir.ParseName(Spl(0) & Spl(1)).GetFolder.MoveHere oItems, 5652
   Next
Bext
Set oDir = Nothing: Set oShell = Nothing

oItems.Filter 73920, "*" & Spl(0) & "*"
If oItems.Count Then oDir.NewFolder Spl(0) & Spl(1) :_