LoginSignup
1
0

More than 3 years have passed since last update.

HTAの待機と中断(WScript.Sleep,WScript.Quitが使えない問題)

Posted at

前提

 HTAはWSHではなく,IEのエンジンを使って動くので,Wscriptから始まるメソッドが使えません(※別途CreateObjectで生成するWscript.shellなどは使えます)。
 Wscript.Echoなんかは全然困らないんですが,困るのがWScript.QuitとWScript.Sleepとです。

中断

 まず,うまくいかない例から紹介します。中断事由があればexitMsgに入れて,exitMsgが空ではなければexitMsgを表示して中断するとします。

        If exitMsg <> "" Then
            MsgBox exitMsg
            Window.Close
        End If

 これでは,HTAの窓が閉じるだけで,後処理が実行されてしまいます。
 なので,安全に中断するためには,基本的に全ての処理をSubプロシージャに入れて,Sub外でCallするようにした上で,windows.Closeの直後にExit Subをして処理を中断します。

hta
<script language="VBScript">
    '全てSubプロシージャで囲む
    Sub close_exit()
        ・・・・(処理略)・・・・
        If exitMsg <> "" Then
            MsgBox exitMsg
            Window.Close
        exit sub
        End If
    End Sub
'ここで呼ぶ
Call close_exit()
</script>

 もちろん,Callを複数並べるとExit Subをしても次のCallに移行してしまうので,基本的にはメインのSubプロシージャ(変な呼び方ですが・・・)のみCallして,その中で関数や他のSubプロシージャを呼ぶようにすると安全に中断できます。

待機

 WScript.ShellのRunメソッドでコマンドラインのTimeoutを実行して対応しました。
Timeout(マイクロソフト公式)

hta
<script language="VBScript">
sub sleep1Second()
    Dim wShell
    Set wShell = CreateObject("WScript.Shell")
    wShell.Run "Timeout.exe /t 1", 0, True
    Set wShell = Nothing
end sub
</script>

これを呼び出して使います。

Run部分
wShell.Run "Timeout.exe /t 1", 0, True

 第一引数でコマンドラインの実行をします。1秒待つようにしていますが,待ち時間を変動させたいのであれば,1はダブルクオーテーションから出して引数で指定できるようにしてもよいと思います。
 第二引数はコマンドプロンプトの窓を表示するかの指定です。通常は表示したくないと思いますので,0を指定します。
 第三引数は返値を返すかを指定します。Falseにすると,後処理はコマンドラインの実行を待たず,せっかくのタイムアウトができなくなるのでTrueにします。

使用例

 これで中断も待機もできるようになりました。
 たとえばIEでページ移動をした後,新しいページを取得するとして,こんな感じで呼び出したりしています。

hta
<script language="VBScript">
sub sleep1Second()
    Dim wShell
    Set wShell = CreateObject("WScript.Shell")
    wShell.Run "Timeout.exe /t 1", 0, True
    Set wShell = Nothing
end sub
Sub main()
    (///ボタンを押すなどしてページ遷移///)
    '1秒間ごとにページの取得を試みて,5秒間取得できなければループを抜ける
    Dim ie 
    Dim s
        For s = 1 To 5
            'ここで待機
            sleep1Second
            On Error GoTo 0 
            On Error Resume next
            Set ie = FETCH_PAGE("対象ページのlocationName")
                If Err.Number=0 then
                    Exit For
                End If
        Next
        If Err.Number=424 then
            MsgBox "画面に遷移できません"
            'ここで画面を閉じて中断
            Window.Close
            Exit Sub
        End If
    On Error GoTo 0 

    Dim htmlDoc 
    Set htmlDoc = ie.document
End sub
'おまけ:画面で取得する関数
Function FETCH_PAGE(locationName)
    Dim shellApp 
    Set shellApp = CreateObject("Shell.Application")
        Dim win 
        For Each win In shellApp.Windows
            If win.Name = "Internet Explorer" And win.locationName = locationName Then
                Set FETCH_PAGE = win
                Exit For
            End If
        Next
End Function
'ここで呼ぶ
Call main()
</script>

 意外と代替手段で対応できることがお分かりいただけると思います。
 HTA,まだまだ現役です。

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0