LoginSignup
0
0

More than 1 year has passed since last update.

VBScript で IE を操作するときの注意点(サポートが終わっても使い続けなければならない人のために)

Last updated at Posted at 2022-01-01

表示倍率は IE のExecWBメソッドで設定できる。例えば、150% にしたいときは、

.ExecWB 63, 0, CLng(150)

と引数を与えてやる。

また、全画面表示は、FullScreenプロパティをTrueにすればできるが、フルスクリーンではメニューバーなども見えなくなってしまうので、単に最大化したい場合がある。
ところが、IE自体にはウィンドウを最大化するメソッドやプロパティは用意されておらず、ウィンドウ操作関連の API を使うしかないのだが、VBScript は API を呼び出すことができないので(ExcelMacro4.0を使えばできるとのことでやってみたが、心が折れた)、結局、ウィンドウメニューの[最大化(x)]をWshShellオブジェクトのSendKeysメソッドで行うことになる。
ただ、そのためには IE のウィンドウを最前面に持ってこなければならない。

OpenIE.vbs
Option Explicit

Const OLECMDID_OPTICAL_ZOOM = 63
Const OLECMDEXECOPT_DODEFAULT = 0

Dim ieApp

Set ieApp = OpenIE("https://www.yahoo.co.jp/")

Call WaitIE(ieApp)
Call WaitId(ieApp, "TPT")
WScript.Sleep 500

'// 表示倍率を150%にする
ieApp.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(150)

'// ウィンドウを最大化する
With CreateObject("WScript.Shell")
    .SendKeys "% "
    WScript.Sleep 500
    .SendKeys "x"
End With

Call ClickLinkTxt(ieApp, "会社概要")

Set ieApp = Nothing

ウィンドウを最前面にするには、これまた API を呼び出す必要があるのだが、幸いなことにWshShellオブジェクトのAppActivateメソッドでウィンドウをアクティブにできる。
ただ、このAppActivateメソッドはたまにウィンドウを最前面にできないときがある。
IE を起動してから、ページを読み込み終わるまで待機(WScript.Sleep)させたりするとうまくいかない場合が多いようだ。

Function OpenIE(ByVal url)

    Dim ieApp

    Set ieApp = CreateObject("Internetexplorer.Application")

    ieApp.Visible = True    '// IEを表示
    ieApp.navigate URL      '// IEでURLを開く

    '// 待機時間を入れるとアクティブにならない
    CreateObject("WScript.Shell").AppActivate("Internet Explorer")

    Set OpenIE = ieApp      '// IEのオブジェクトを返す

    Set ieApp = Nothing

End Function

IE の画面上でテキストボックスに入力したり、リンクやボタンをクリックしたりする操作は、IE がページを読み終わっていないとエラーになる。
なので、読み終わるまでプログラムを待機させる必要があるが、通常は、IE のBusyプロパティやReadyStateプロパティをチェックし、WScript.Sleep(VBScript には DoEventsがない)などで待機させる。が、この待機もなぜかうまくいかないときがある。
その場合は、ターゲットの DOM を読み込むまで待機させる関数を作っておくとエラー回避できる確率が上がる。

'// ページの読み込みが終わるまで待機する

Sub WaitIE(ie_app)

    Do While ie_app.Busy = True Or ie_app.ReadyState <> 4
        WScript.Sleep 100
    Loop

    Do While ie_app.document.ReadyState <> "complete"
        WScript.Sleep 100
    Loop

End Sub
'// 指定した Id属性を読み終わるまで待つ
'// 20000ミリ秒(20秒)以内に読み込めなかったら終了

Sub WaitId(ie_app, Byval id_value)

    Dim isId, t

    isID = False

    Do While isId = False
        isId = Not ie_app.document.getElementById(id_value) is Nothing
        WScript.Sleep 200
        t = t + 200
        If t > 20000 Then MsgBox "ブラウザの応答がありません。": WScript.Quit
    Loop

End Sub
'// tag_nameタグを cnt個読み込むまで待つ
'// 20000ミリ秒(20秒)以内に読み込めなかったら終了

Sub WaitTag(ie_app, ByVal tag_name, ByVal cnt)

    Dim n, t

    Do While n < cnt
        n = ie_app.document.getElementsByTagName(tag_name).Length
        WScript.Sleep 200
        t = t + 200
        If t > 20000 Then MsgBox "ブラウザの応答がありません。": WScript.Quit
    Loop

End Sub
'// name属性が name_value の要素を cnt個読み込むまで待つ
'// 20000ミリ秒(20秒)以内に読み込めなかったら終了

Sub WaitName(ie_app, ByVal name_value, ByVal cnt)

    Dim n, t

    Do While n < cnt
        n = ie_app.document.getElementsByName(name_value).Length
        WScript.Sleep 200
        t = t + 200
        If t > 20000 Then MsgBox "ブラウザの応答がありません。": WScript.Quit
    Loop

End Sub
'// class属性が class_name の要素を cnt個読み込むまで待つ
'// 20000ミリ秒(20秒)以内に読み込めなかったら終了

Sub WaitClass(ie_app, ByVal class_name, ByVal cnt)

    Dim n, t

    Do While n < cnt
        n = ie_app.document.getElementsByClassName(class_name).Length
        WScript.Sleep 200
        t = t + 200
        If t > 20000 Then MsgBox "ブラウザの応答がありません。": WScript.Quit
    Loop

End Sub
'// 文字列が link_txt のリンクをクリックする

Sub ClickLinkTxt(ie_app, ByVal link_txt)

    Dim elm

    For Each elm In ie_app.document.getElementsByTagName("a")
        If InStr(elm.innerText, link_txt) > 0 Then
            elm.Click
            Exit For
        End If
    Next

End Sub

<更新履歴>
[2022-02-06]Like演算子は VBS では使えないので InStr関数に修正

0
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
0
0