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