Создание файлов в одну папку с одинаковыми названиями

Добрый вечер...Облазил много форумов сайтов..ненашол ответ на свой вопрос....надеюсь вы мне поможете ....
теперь по сути...

есть файл 1.rar ... нужно чтоб создало папку с названием "1" и чтоб в этой папке были такие файлы: сам этот файл 1.rar и два новых 1.txt и 1.jpg

Какого вида должен быть код ?? Есть просто код как сделать папку с именем файла и переместить в неё саму этот файл...а вот еслиб ещё паралельно создало два файлика с заданыйм расширением былоб вообще гуд !!!

Заранее спасибо!...Надеюсь мне кто-то поможет....Вот код того скрипта

'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в текущей панели
' в параметрах вызова из TC должно быть прописано:
' %L

' Для создания папок в противоположной панели
' в параметрах вызова из TC должно быть прописано:
' %L "%T"
'=====================================================================

If WScript.Arguments.Count = 0 Then
MsgBox "Не указаны параметры!", vbOKOnly + vbError, "Внимание!"
Wscript.Quit
End If

Dim TempFile, FSO, SelFile,Ext1,NewFilePath
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
Set SelFile = FSO.GetFile(TempFile.ReadLine)
FileName = FSO.GetBaseName(SelFile)
FilePath = SelFile.ParentFolder
If WScript.Arguments.Count > 1 Then
NewFilePath = WScript.Arguments(1) & FileName
NewFilePath = WScript.Arguments(1) & NewFilePath & "." & Ext1
Else
NewFilePath = FilePath & "\" & FileName
End If
If Not FSO.FolderExists(NewFilePath) Then
FSO.CreateFolder(NewFilePath)
End If
If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
FSO.MoveFile SelFile, NewFilePath & "\"
Else
MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
End If
Loop
Set TempFile = Nothing
Set FSO = Nothing
Set SelFile = Nothing
Wscript.Quit