[Iska]

belgarion, исходная папка задаётся аргументом скрипта. Также можно просто перетаскивать папку на скрипт в Проводнике.

Если совсем-совсем не хотите, то:

Скрытый текст

Код:

Option Explicit

Dim strSourceFolder

Dim objFile

Dim strDestFolder


With WScript.CreateObject("Scripting.FileSystemObject")
	strSourceFolder = .GetAbsolutePathName("C:\Мои проекты\16")
	
	If .FolderExists(strSourceFolder) Then
		For Each objFile In .GetFolder(strSourceFolder).Files
			strDestFolder = .BuildPath(strSourceFolder, Split(objFile.Name, "_")(0))
			
			If Not .FolderExists(strDestFolder) Then
				.CreateFolder strDestFolder
			End If
			
			WScript.Echo objFile.Name, "--->", strDestFolder
			
			objFile.Move strDestFolder & "\"
		Next
	Else
		WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
		WScript.Quit 2
	End If
End With

WScript.Quit 0