alpap , почему бы тебе не воспользоватся рекомендацией Cortina ?
Надеюсь, что тебе просто интересно как это на VBS, поэтому держи...Подправишь сам.
У меня длинновато получилось ,но зато работает с именами, содержащими не одну точку,
а также для расширений не равных трём символам.
Если, кто знает, как добиться этого по другому, пожалуйста поделитесь.
Код:

'-------------------------------------------------------------------------
' Определение полного имени
If WScript.Arguments.Count = 1 Then
sFile = WScript.Arguments.Item(0)
Set fso = CreateObject("Scripting.FileSystemObject")
End If
'------------------
' короткое имя
Filespec =sfile
Set fso = CreateObject( "Scripting.FileSystemObject" )
Set file = fso.GetFile(fileSpec)
'----------------------------------------------
' Извлекаем расширение, можно будет добавлять по желанию.
Dim i, k, m, sym, Ext
For k = 0 To Len(SFile)
sym = Mid(SFile,Len(SFile) - k,1)
If sym = "." Then
m = Len(SFile) - k + 1
k = Len(SFile)
end if
Next
Ext = ""
For i = m To Len(SFile)
Ext = Ext & Mid(SFile,i,1)
Next
'------------------
' Отсекаем расширение
' Узнаём последнюю "."
S = file.ShortName
position = InStrRev(s,".")
' ----------------------
' Получить имя без расширения
str = file.ShortName
intCharacters = position
strNew = Left(str, intCharacters)
'-------------------------------------
' Можно отсеч последнюю точку, может надо будет...
'str1 = strNew
'intLength = Len(str1)
'intCharacters = intLength - 1
'strNew1 = Left(str1, intCharacters)
'----------------------------------
' узнаём путь к папке
FullPath = fileSpec
Dummy = Split(FullPath, "\")
JustFile = Dummy(UBound(Dummy))
JustPath = Left(FullPath, Len(FullPath) - Len(JustFile))
'---------------------------------------------
' Создаём
fso.CreateTextFile(JustPath & strnew & "txt")