VAMIE2 (VBA Auto Mation for Internet Explorer) @ VBA

VAMIE2.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VAMIE2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' VAMIE2 (VBA Auto Mation for Internet Explorer)
'
' This Class Module:
'   First Release 2012/8/22
'   Created By D*isuke YAMAKWA
'
' Ref.:
'   Excel VBAのマクロで, IEを自動操作しよう(DOMセレクタ関数をVBAで自作)
'   http://d.hatena.ne.jp/language_and_engineering/20090710/p1

#If VBA64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hWnd As Long, _
    ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, _
    ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long
#End If

Private ie As Variant

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

' ======================================================
' プロパティ
Property Let Visible(x As Boolean)
    ie.Visible = x
End Property

Property Get Visible() As Boolean
    Visible = ie.Visible
End Property

Property Get Document()
    Set Document = ie.Document
End Property

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

' =======================================================
' メソッド

'URLを開く
Sub Navigate(url)
    ie.Navigate url
    Wait
End Sub

' 閉じる
Sub Quit()
    ie.Quit
End Sub

'javascriptを実行
Sub RunJS(code As String)
    Call ie.Document.Script.setTimeout("javascript:" & code, 200)
    Wait
End Sub

' --------------------------------------------------
Sub MoveWindow_(ByVal x As Long, ByVal y As Long)
    Call MoveWindow(ie.hWnd, x, y, ie.Width, ie.Height, 1)
End Sub

Sub ResizeWindow(ByVal nWidth As Long, ByVal nHeight As Long)
    Call MoveWindow(ie.hWnd, ie.Left, ie.Top, nWidth, nHeight, 1)
End Sub

' --------------------------------------------------
'DOM要素の取得
Function GetByID(id As String)
    ' 注：～IE7のgetElementByIdはnameも参照する
    Set GetByID = ie.Document.GetElementByID(id)
End Function

Function GetByTagName(tagName As String)
    Set GetByTagName = ie.Document.getElementsByTagName(tagName)
End Function

Function GetByName(name As String)
    Set GetByName = ie.Document.getElementsByName(name)
End Function

'クラス内部記述用（後方互換性確保のため）
Private Function gid(id)
    Set gid = ie.Document.GetByID(id)
End Function

' 簡易DOMセレクタ
'arr: Array("id/tag/name", **, **) ex. Array("tag", "input", 0, "id", "id1", 0)
Function DOMSelect(arr)
    Dim parent_obj As Object: Set parent_obj = ie.Document
    Dim child_obj As Object
    Dim cur
    Dim dom_id, name, tag_name, index_num
    
    cur = 0
    Do
        If arr(cur) = "id" Then
            dom_id = arr(cur + 1)
            Set child_obj = parent_obj.GetElementByID(dom_id)
            cur = cur + 3
            
        ElseIf arr(cur) = "name" Then
            name = arr(cur + 1)
            index_num = arr(cur + 2)
            Set child_obj = parent_obj.getElementsByName(name)(index_num)
            cur = cur + 3
            
        ElseIf arr(cur) = "tag" Then
            tag_name = arr(cur + 1)
            index_num = arr(cur + 2)
            Set child_obj = parent_obj.getElementsByTagName(tag_name)(index_num)
            cur = cur + 3
        End If
        
        Set parent_obj = child_obj
        
        If cur > UBound(arr) Then Exit Do
    Loop
    
    Set domselec = parent_obj

End Function

' --------------------------------------------------
'テキストを取得
Function GetInnerText(dom_id)
    GetInnerText = gid(dom_id).innerText
End Function

'HTMLコードを取得
Function GetInnerHTML(dom_id)
    GetInnerHTML = gid(dom_id).innerHTML
End Function

' --------------------------------------------------
' テキストを入力
Sub SetTextField(dom_id, val)
    gid(dom_id).value = val
    Wait
End Sub

' 送信ボタンやリンクをクリック
Sub Click(dom_id)
    gid(dom_id).Click
    Wait
End Sub

' チェックボックスの状態をセットする
Sub SetCheckState(dom_id, checked_flag)
    ' 希望通りのチェック状態でなければクリック
    If Not (gid(dom_id).Checked = checked_flag) Then
        Click (dom_id)
    End If
End Sub

' セレクトボックスを文言ベースで選択する
Sub SetSelectboxByLabel(dom_id, label)
    If Len(label) < 1 Then
      Exit Sub
    End If
    
    Dim opts As Object
    Dim i As Integer
    Set opts = gid(dom_id).Options
    For i = 0 To opts.length - 1
        If opts(i).innerText = label Then
            opts(i).Selected = True
            Exit Sub
        End If
    Next i
    
End Sub

' ラジオボタンを値ベースで選択する
' ※idではなくnameで選択
Sub SetRadioButtonByLabel(name, value)
    Dim radios, i
    
    If Len(value) < 1 Then
        Exit Sub
    End If
    
    Set radios = ie.Document.getElementsByName(name)
    For i = 0 To radios.length - 1
        If radios(i).value = CStr(value) Then
            radios(i).Click
            Wait
            Exit Sub
        End If
    Next i

End Sub


' IEがビジー状態の間待機する
Sub Wait(Optional milliseconds As Long)
    Do While ie.Busy = True And ie.READYSTATE <> READYSTATE_COMPLETE
        Sleep 100
        DoEvents
    Loop
    
    Sleep milliseconds
End Sub

' IEのVerを取得
Function GetIEVer()
    Dim ie, FS
    Set ie = CreateObject("InternetExplorer.Application")
    Set FS = CreateObject("Scripting.FileSystemObject")

    GetIEVer = Fix(val(FS.GetFileVersion(ie.FullName)))
End Function