OKWave

CIE.cls

'YU-TAMG氏のコード改

'https://gist.github.com/1619670

' 要・Microsoft Internet Controls 参照設定

Option Explicit

 

Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Const WM_COMMAND As Long = &H111&

 

Private WithEvents ie As InternetExplorer

Private mDocumentComplete As Boolean

Private m_CommandStateChange  As Boolean

 

Private Sub Class_Initialize()

    Set ie = New InternetExplorer

    ie.Visible = True

    Navigate "about:blank"

End Sub

 

Public Sub Navigate(ByRef URL As String)

    mDocumentComplete = False

    ie.Navigate2 URL

    Do

        DoEvents

    Loop Until mDocumentComplete

End Sub

 

Public Property Get IeObject() As InternetExplorer

    Set IeObject = ie

End Property

 

Private Sub ie_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)

    Dim hwnd As LongPtr

    hwnd = FindWindow("#32770", "Web ページからのメッセージ")

'    hwnd = GetLastActivePopup(ie.hwnd)

    If hwnd <> 0 Then

        Debug.Print hwnd, ie.hwnd

        PostMessage hwnd, WM_COMMAND, vbOK, 0

        m_CommandStateChange = True

    End If

End Sub

 

Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    mDocumentComplete = True

End Sub

 

Public Sub CommandStateChange()

    m_CommandStateChange = False

    Do

        DoEvents

    Loop Until m_CommandStateChange

End Sub

TestCIE.bas

Option Explicit

Public Sub TestIE_Automation()

    Const URL As String = "http://kamicha1.web.fc2.com/Excel/Test20090726.html"

    Dim ie  As CIE

    Debug.Print "Start", Now

    Set ie = New CIE

    ie.Navigate URL

    'ボタンクリックコード追加
    ie.IeObject.Document.getElementById("popOK").Click

    ie.CommandStateChange

    Debug.Print "Exit", Now

End Sub