Я неточно выразился, но всё же.
Хотелось бы пример такого кода.]]>
Set WshShell = CreateObject("WScript.Shell")
…
strCurrentDirectory = WshShell.CurrentDirectory
…
<код по Dialog Open File>
…
WshShell.CurrentDirectory = strCurrentDirectory
…Вызов диалога меняет текущую рабочую папку скрипта. Как следствие перестают читаться файли настроек и т.д. "нацеленые" на как бы "текущую" папку. Как этот победить? Есть команда смены папки?
Получить текущую папку труда не составляет. Как вернуться обратно потом?
]]>Set WshShell = CreateObject("WScript.Shell")
…WshShell.CurrentDirectory…Set WshShell = WScript.CreateObject("WScript.Shell")
WScript.Echo WshShell.CurrentDirectory
А если через HTA нужно сделать?
]]>Ниже исходники + примеры
Класс
Class clsOPTSHOLDLib
Private WshExec, oDlg, ShellWindows, form_id, id, st, ShellWindow
Private Sub Class_Initialize()
On Error Resume Next
Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
"<hta:application showintaskbar=no />" &_
"<object id=" & id & " classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object>" &_
"<object id=oDlg classid='clsid:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B'></object>""")
st = Now
Do
For Each ShellWindow in ShellWindows
form_id = Clng(ShellWindow.id)
if form_id = id Then
Set oDlg = ShellWindow.document.all.oDlg.Object
Exit Sub
End if
Next
Loop Until DateDiff("s",st,now) => 10
On Error Goto 0
if isEmpty(oDlg) Then Err.Raise vbObjectError, "HtmlDlgHelper", "Dialog creation failed."
End Sub
Public Property Get HtmlDlgHelper()
Set HtmlDlgHelper = oDlg
End Property
Private Sub Class_Terminate()
On Error Resume Next
WshExec.Terminate()
End Sub
End ClassПример с использованием класса
Option Explicit
Dim OPTSHOLDLib, HtmlDlgHelper, ret
Set OPTSHOLDLib = New clsOPTSHOLDLib
Set HtmlDlgHelper = OPTSHOLDLib.HtmlDlgHelper
ret = HtmlDlgHelper.openfiledlg()
MsgBox retWSC (Windows Script Component)
<?xml version="1.0"?>
<component>
<?component error="true" debug="true"?>
<registration
description="HtmlDlgHelper"
progid="HtmlDlgHelper.wsc"
version="1.00"
classid="{86376100-1f27-4d81-8328-8c6565096c0e}"
>
</registration>
<public>
<property name="fonts">
<get/>
</property>
<method name="openfiledlg">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="title"/>
</method>
<method name="savefiledlg">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="title"/>
</method>
<method name="choosecolordlg">
<PARAMETER name="initColor"/>
</method>
<method name="getCharset">
<PARAMETER name="fontName"/>
</method>
<method name="openfiledlgex">
<PARAMETER name="initFile"/>
<PARAMETER name="initDir"/>
<PARAMETER name="filter"/>
<PARAMETER name="initFilterIndex"/>
<PARAMETER name="title"/>
</method>
</public>
<script language="VBScript">
<![CDATA[
Option Explicit
Dim OPTSHOLDLib, HtmlDlgHelper
Set OPTSHOLDLib = New clsOPTSHOLDLib
Set HtmlDlgHelper = OPTSHOLDLib.HtmlDlgHelper
Class clsOPTSHOLDLib
Private WshExec, oDlg, ShellWindows, form_id, id, st, ShellWindow
Private Sub Class_Initialize()
On Error Resume Next
Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
"<hta:application showintaskbar=no />" &_
"<object id=" & id & " classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object>" &_
"<object id=oDlg classid='clsid:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B'></object>""")
st = Now
Do
For Each ShellWindow in ShellWindows
form_id = Clng(ShellWindow.id)
if form_id = id Then
Set oDlg = ShellWindow.document.all.oDlg.Object
Exit Sub
End if
Next
Loop Until DateDiff("s",st,now) => 10
On Error Goto 0
if isEmpty(oDlg) Then Err.Raise vbObjectError, "HtmlDlgHelper", "Dialog creation failed."
End Sub
Public Property Get HtmlDlgHelper()
Set HtmlDlgHelper = oDlg
End Property
Private Sub Class_Terminate()
On Error Resume Next
WshExec.Terminate()
End Sub
End Class
]]>
</script>
<script language="JScript">
<![CDATA[
function get_fonts()
{
return HtmlDlgHelper.fonts
}
function openfiledlg(initFile,initDir,filter,title)
{
return HtmlDlgHelper.openfiledlg(initFile,initDir,filter,title)
}
function savefiledlg(initFile,initDir,filter,title)
{
return HtmlDlgHelper.savefiledlg(initFile,initDir,filter,title)
}
function choosecolordlg(initColor)
{
return HtmlDlgHelper.choosecolordlg(initColor)
}
function getCharset(fontName)
{
return HtmlDlgHelper.getCharset(fontName)
}
function openfiledlgex(initFile,initDir,filter,initFilterIndex,title)
{
return HtmlDlgHelper.openfiledlgex(initFile,initDir,filter,initFilterIndex,title)
}
]]>
</script>
</component>Пример использования WSC
Option Explicit
Dim HtmlDlgHelper, ret
Set HtmlDlgHelper = GetObject("script:" & Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")) & "HtmlDlgHelper.wsc")
ret = HtmlDlgHelper.openfiledlg("",,"Картинки (*.jpg;*.gif;*.png;*.bmp)|*.jpg;*.gif;*.png;*.bmp|Все файлы (*.*)|*.*","Выберите картинку...")
MsgBox ret]]>Есть команда смены папки?
REGEDIT
…Вот такой вопросец. Вызов диалога меняет текущую рабочую папку скрипта. Как следствие перестают читаться файли настроек и т.д. "нацеленые" на как бы "текущую" папку. Как этот победить? Есть команда смены папки?
]]>чтобы была возможность выбора не единственного файла, а множественный выбор
Если речь о диалоге UserAccounts.CommonDialog, то у него есть свойство Flags, если устанавливаем = &H0200 - получаем возможность выбрать несколько файлов.
]]>Какой именно пример? В приведённом коде меняете MsgBox на присвоение значения переменной:
sPath2File = [Диалог].object.openfiledlg("C:\*.jpg;*.gif;*.png;*.bmp ",,"Картинки (*.jpg;*.gif;*.png;*.bmp)|*.jpg;*.gif;*.png;*.bmp|Все файлы (*.*)|*.*","Выберите картинку...")после закрытия окна:
[Документ].parentWindow.close()вписываете проверку, что не была нажата кнопка «Отмена», и пользуетесь полученным путём к файлу:
If Len(sPath2File) <> 0 Then
' Здесь Ваш код, например
WScript.Echo sPath2File
End If