Странно чето не получается при использовании в HTA перебрал все возможные варианты:
<div class="unvisible" id="MenuOutChooseTableRename">
<input type="button" id="MenuOutChooseTableRenameId" value="Переименовать">
</div>
'Обработчик кнопки переименования
Sub MenuOutChooseTableRenameId_OnClick()
Dim objHTMLOptionElement
Dim iCount
iCount = 0
For Each objHTMLOptionElement In MenuOutChooseTableoHTMLSelectElement.options
If objHTMLOptionElement.selected Then
iCount = iCount + 1
End If
Next
'MsgBox iCount
If iCount = 1 Then
ReDim arrSelection(iCount-1, 1)
iCount = 0
For Each objHTMLOptionElement In MenuOutChooseTableoHTMLSelectElement.options
If objHTMLOptionElement.selected Then
arrSelection(iCount, 0) = objHTMLOptionElement.Value
arrSelection(iCount, 1) = objHTMLOptionElement.Text
iCount = iCount + 1
End If
Next
'MsgBox arrSelection(0,0)
'Проверка на файл открыт или не открыт. - "Ошибка - файл открыт в другой программе."
On Error Resume Next
Dim OpenFileBuzyCheck
Set objFso = CreateObject("Scripting.FileSystemObject")
Set OpenFileBuzyCheck = objFso.OpenTextFile(arrSelection(0,0), 8, True)
'MsgBox "err.description" &err.description
If Err.Number > 0 Then
MsgBox "Файл " &arrSelection(0,0) &" открыт в другой программе. Закройте программу использующую данный файл и повторите попытку!"
Else
Dim Message
Dim Title, Text1, Text2
' Определить переменные диалоговых окон.
Message = "Введите имя файла"
Title = "Введите имя файла"
Text1 = "Было нажато на отмену"
Text2 = "Вы ввели:" & vbCrLf
t = 1
result = ""
dim ExitFromName
Do
result = InputBox(Message, Title,, 3500, 3500)
If result = "" Then ' Отмена
ExitFromName = MsgBox ("Вы действительно хотите выйти не внося имя файла?", 36, "Не до конца введенное значение")
'MsgBox ExitFromName
If ExitFromName = 6 Then
Exit Do
End If
End If
Loop While (Len(result) < 1)
If Len(result) > 0 Then
Dim FileName,ExtFileName
Set FileName = objFso.GetFile(arrSelection(0,0))
ExtFileName = objFso.GetExtensionName(arrSelection(0,0))
'MsgBox FileName.Name
'MsgBox result
'MsgBox ExtFileName
'objFSO.MoveFile FileName.Path, result & "." & ExtFileName
FileName.Name = result & "." & ExtFileName
End If
End IF
OpenFileBuzyCheck.Close
Err.Clear
On Error Goto 0
else
If iCount > 1 Then
MsgBox "Выберите один файл!"
End If
If iCount = "" Then
MsgBox "Не были выбраны значения из таблицы!"
End If
If iCount = "0" Then
MsgBox "Не были выбраны значения из таблицы!"
End If
End If
End Sub