【落書き】勢いでExcelVBA使って神龍Webテストを再現してみた

qiita.com

神龍何回名乗るんだよｗｗ と思いながらも面白そうだったのでチャレンジ。

VBAのClassモジュールは初めて使ったけど作り込んだら便利そう。

mainモジュール

Sub callDragon()

    Dim 我が名は神龍 As New ieDoragon
        我が名は神龍.URLにアクセスしてやろう "https://kids.yahoo.co.jp/"
        我が名は神龍.フィールドに入力してやろう "調べたいことばをいれてみよう！", "ねこ"
        我が名は神龍.クリックしてやろう "さがす", "button"
        我が名は神龍.テキストがあるか確認してやろう "ネコ - Wikipedia"
        我が名は神龍.入力フィールドに文字を追加してやろう "調べたいことばを入れてみよう！", "　買い方"
        我が名は神龍.クリックしてやろう "さがす", "button"
        我が名は神龍.テキストがあるか確認してやろう "さがしているのは"
        我が名は神龍.クリックしてやろう "猫の飼い方", "a"
        我が名は神龍.入力フィールドに文字が入っているか確認してやろう "調べたいことばを入れてみよう！", "猫の飼い方"
        我が名は神龍.フィールドに入力してやろう "調べたいことばを入れてみよう！", "不倫"
        我が名は神龍.クリックしてやろう "さがす", "button"
        我が名は神龍.テキストがあるか確認してやろう "このページは表示できません。"
        我が名は神龍.スクリーンショットを撮ってやろう ThisWorkbook.Path
        
End Sub

ieDragonモジュール

Private objIE As Object

' 初期化処理
Private Sub Class_Initialize()
    Set objIE = CreateObject("InternetExplorer.Application")
        objIE.Visible = True
    Debug.Print Time & " " & "initalized"
End Sub

' 終了時処理
Private Sub Class_Terminate()
    objIE.Quit 'IE終了
    Set objIE = Nothing 'IEオブジェクト開放
    Debug.Print Time & " " & "terminated"
End Sub

' IEを起動・終了する
Public Sub URLにアクセスしてやろう(url)
    objIE.navigate url 'URLに接続
    Call IEWait(objIE) 'IEを待機
End Sub

' 特定要素をクリック
Public Sub クリックしてやろう(text, tagName)
    Dim link, target
    For Each link In objIE.document.getElementsByTagName(tagName)
        If InStr(link.innertext, text) <> 0 Then
            Set target = link
            Exit For
        End If
    Next
    target.Click
    Call IEWait(objIE) 'IEを待機
End Sub

' 特定のplaceholderにマッチするinputタグにvalueを入力
Public Sub フィールドに入力してやろう(placeholder, value)
    Call WaitFor(1) '指定秒数待機
    objIE.document.querySelector("input[placeholder=""" & placeholder & """]").value = value
    Call WaitFor(1) '指定秒数待機
End Sub

' 特定のplaceholderにマッチするinputタグにvalueを入力
Public Sub 入力フィールドに文字を追加してやろう(placeholder, value)
    Call WaitFor(1) '指定秒数待機
    With objIE.document.querySelector("input[placeholder=""" & placeholder & """]")
        .value = .value & value
    End With
    Call WaitFor(1) '指定秒数待機
End Sub

' 文字列が存在するかチェック
Public Sub テキストがあるか確認してやろう(text)
    If InStr(objIE.document.querySelector("body").innertext, text) <> 0 Then
        Debug.Print Time & " " & text & "は存在するようだ"
    End If
End Sub

' 文字列が存在するかチェック
Public Sub 入力フィールドに文字が入っているか確認してやろう(placeholder, text)
    If InStr(objIE.document.querySelector("input[placeholder=""" & placeholder & """]").value, text) <> 0 Then
        Debug.Print Time & " " & "入力フィールドに「" & text & "」は存在するようだ"
    End If
End Sub

' スクリーンショットを撮ってやろう
Public Sub スクリーンショットを撮ってやろう(savePath As String)
    Call IEShot(objIE, False, savePath & "\" & Format(Date, "yyyymmdd") & ".bmp")
End Sub

'IEを待機
Public Function IEWait(ByRef objIE As Object)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
    Loop
End Function

'指定秒待機
Public Function WaitFor(ByVal second As Integer)
    Dim futureTime As Date
 
    futureTime = DateAdd("s", second, Now)
 
    While Now < futureTime
        DoEvents
    Wend
End Function

IEShotモジュール

↓こちらを拝借

www.ryokurian.jp

したんだけどなんか上手くいかない。

あとクリックしてやろうの再現度が低くて無念