InternetExplorerを操作する（クラス化）

昨日記述した「InternetExplorerを操作する」の内容から、InternetExplorer操作クラスを作成してみました。

' InternetExplorer操作クラス
'
' 使用方法
' ・サンプル
'    Dim ie As New IEClass
'    Call ie.navigate ("http://www.google.co.jp")
'    Call ie.setValue("q", "hello vba")
'    Call ie.click("btnG")
'    MsgBox ieObj.getPage()
' ・インスタンスを作成した際にInternetExplorerが表示されます。
' ・インスタンスが破棄されるときにInternetExplorerが閉じられます。
'
' 前提条件
' ・Windows Vista または IE 7 未対応
'
' 改訂履歴
' ・2009年1月 新規作成

Option Explicit

Private Enum READYSTATE
    READYSTATE_UNINITIALIZED = 0
    READYSTATE_LOADING = 1
    READYSTATE_LOADED = 2
    READYSTATE_INTERACTIVE = 3
    READYSTATE_COMPLETE = 4
End Enum

' --------------------------------------------------
' メンバ変数
' --------------------------------------------------
Private ie As Object

' --------------------------------------------------
' メソッド
' --------------------------------------------------

' コンストラクタ
Private Sub Class_Initialize()
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
End Sub

' デストラクタ
Private Sub Class_Terminate()
    ie.Quit
    Set ie = Nothing
End Sub

' IEの処理完了を待ちます。
Private Sub wait()
    Do While ie.READYSTATE <> READYSTATE_COMPLETE
        DoEvents '一旦OSに制御を返します
    Loop
    Do While ie.document.READYSTATE <> "complete"
        DoEvents '一旦OSに制御を返します
    Loop
    Do While ie.Busy
        DoEvents '一旦OSに制御を返します
    Loop
End Sub

' Webページを開きます。
Public Sub navigate(url As String)
    ie.navigate (url)
    wait
End Sub

' フォームのボタンをクリックします。
Public Sub click(name As String)
    getElement(name).click
    wait
End Sub

' タグを取得します。
Public Function getElement(name As String) As Object
    Dim element As Object
    Dim tmp As Object
    
    Set element = Nothing
    For Each tmp In ie.document.getElementsByName(name)
        If element Is Nothing Then
            Set element = tmp
        Else
            MsgBox ("name属性=[" & name & "]のタグが複数ありました。")
            Err.Raise vbObjectError
        End If
    Next
    If element Is Nothing Then
        MsgBox ("name属性=[" & name & "]のタグがありませんでした。")
        Err.Raise vbObjectError
    End If
    
    Set getElement = element
End Function

' 指定タグのHTMLを取得します。
Public Function getHtml(name As String) As String
    getHtml = getElement(name).innerHTML
End Function

' 表示中のページのHTMLを取得します。
Public Function getPage() As String
    getPage = ie.document.DocumentElement.outerHTML
End Function

' Value属性を取得します。
Public Function getValue(name As String) As String
    getValue = getElement(name).Value
End Function

' フォームのタグにValue属性を設定します。
Public Sub setValue(name As String, val As String)
    getElement(name).Value = val
End Sub