12
18

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

VBAでInternetExplorer上のJavaScriptを無理やり動かすよ!

Last updated at Posted at 2019-03-02

みんな大好きInternetExplorer11のJavaScriptを、みんな大好きなExcelのVBAから動かします。

##なにが嬉しいの?
・現在、表示されているIEのJavaScriptの保持している変数の中身を出力できるよ!
・無理やりJavaScriptで例外を発生させたときの挙動を確かめられるよ!
・サーバー側のソースコードを書き換えずにローカル環境でJavaScriptの関数をテスト用に置き換えられるよ!

ExcelVBAなので、手足を縛ってプログラムを開発するのが性癖なマゾい会社でも使えるよ!やったぜ!

##環境
InternetExplorer11
Windows10
Office16 Excel 32bit

なお、64bitのExcelを使っている箇所はlongでなく、longPtrとかにしないと動かないと思うけど、ぶっちゃけ64bitマシン支給するようなブルジョワジーの組織だったらVisualStudio使わせてもらってC#で書いた方がいいと思います。

##サンプル

IEAuto.bas
 Option Explicit

' Microsoft HTML Object Libraryを参照設定すること

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Object) As Long

Private mIEWndList As Collection
Private Type UUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

' MSHTML.IHTMLDocumentのキャッシュを検索する
Public Sub RefreshBrowserCache()
    Set mIEWndList = New Collection
    
    Call EnumWindows(AddressOf EnumIEWndProc, 0)
End Sub
' 指定の名称を含むタイトルのブラウザを検索する
Public Function FindBrowser(ByVal title As String) As MSHTML.IHTMLDocument2
    Dim r As MSHTML.IHTMLDocument2
    
    If mIEWndList Is Nothing Then
        Call RefreshBrowserCache
    End If
    
    Set r = FindBrowserInCache(title)
    If Not r Is Nothing Then
        Set FindBrowser = r
        Exit Function
    End If
    
    Call RefreshBrowserCache
    Set FindBrowser = FindBrowserInCache(title)
    
End Function

' キャッシュの中から指定の名称を含むタイトルのブラウザを検索する
Private Function FindBrowserInCache(ByVal title As String) As MSHTML.IHTMLDocument2
    Dim d As MSHTML.IHTMLDocument2
    For Each d In mIEWndList
        If InStr(d.title, title) > 0 Then
            Set FindBrowserInCache = d
            Exit Function
        End If
    Next
    
End Function



' コールバック関数
Private Function EnumIEWndProc(ByVal hwnd As Long, lParam As Long) As Boolean
    Const FRAME_NAME = "IEFrame"
    Const FRAME_NAME_EDGE = "TabWindowClass" 'Edgeの場合のクラス名
    
    Dim strClassName As String * 128
    Dim lngRet As Long
    
    strClassName = ""
    Call GetClassName(hwnd, strClassName, 128)
    Dim c As String
    c = Left(strClassName, Len(Trim(strClassName)) - 1)
    If c = FRAME_NAME Or c = FRAME_NAME_EDGE Then
        EnumChildWindows hwnd, AddressOf EnumIEServerWndProc, 0
    End If
    'Debug.Print "[" & Trim(strClassName) & "_]"
    EnumIEWndProc = True
End Function

' コールバック関数
Private Function EnumIEServerWndProc(ByVal hwnd As Long, ByVal lParam As Object) As Long
    Const SERVER_NAME = "Internet Explorer_Server"
    Dim strClassName As String * 128
    Dim lngRet As Long
    Dim doc As MSHTML.IHTMLDocument2
    
    strClassName = ""
    Call GetClassName(hwnd, strClassName, Len(strClassName))
    If Left(strClassName, Len(Trim(strClassName)) - 1) = SERVER_NAME Then
        Set doc = GetHTMLDocument(hwnd)
        If Not doc Is Nothing Then
            mIEWndList.Add doc
        End If
    End If
    EnumIEServerWndProc = 1
End Function

Private Function GetHTMLDocument(ByVal hwnd As Long) As MSHTML.IHTMLDocument2
    Dim doc As MSHTML.IHTMLDocument2
    Dim lMsg As Long
    Dim lRet As Long
    Dim hr As Long
    Dim IID_IHTMLDocument As UUID
    
    With IID_IHTMLDocument
        .Data1 = &H626FC520
        .Data2 = &HA41E
        .Data3 = &H11CF
        .Data4(0) = &HA7
        .Data4(1) = &H31
        .Data4(2) = &H0
        .Data4(3) = &HA0
        .Data4(4) = &HC9
        .Data4(5) = &H8
        .Data4(6) = &H26
        .Data4(7) = &H37
    End With
    lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
    If lMsg <> 0 Then
        SendMessageTimeout hwnd, lMsg, 0, 0, &H2, 1000, lRet
        If lRet <> 0 Then
            If ObjectFromLresult(lRet, IID_IHTMLDocument, 0, doc) = 0 Then
                Set GetHTMLDocument = doc
            End If
        End If
    End If
End Function

サンプル
Public Sub test()
    Dim b As MSHTML.IHTMLDocument3
    Dim w As Object

    Set b = IEAuto.FindBrowser("Google")
    If b Is Nothing Then
        Debug.Print "見つからない"
        Exit Sub
    End If
    
    Dim r As Variant
    Dim elems As MSHTML.IHTMLElementCollection
    Dim elem As MSHTML.IHTMLElement
    Set elems = b.getElementsByName("btnK")
    Debug.Print elems.Item(0).getAttribute("value")
    
    ' 以下のような感じでJavaScriptにアクセスできるがEdgeの場合はアクセス違反になる
    ' 管理者権限も無駄
    Dim testId As Variant
    testId = Timer
    b.parentWindow.execScript ("function x() { result = 5+5+4; console.log('TEST'); var d = document.createElement('div'); d.id = 'test_elem" & testId & "'; d.innerHTML  = result; document.getElementsByTagName('body').item(0).appendChild(d); }; x();")
     
    Set elem = b.getElementById("test_elem" & testId)
    Debug.Print elem.innerHTML
    
End Sub

解説

IEのウィンドウハンドルからMSHTML.IHTMLDocumentを取得してあとはよくあるIEの自動操作をしています。
IHTMLDocumentに変換できるウィンドウのクラス名は「Internet Explorer_Server」です。
IE11の場合は「IEFrame」クラスの子ウィンドウになっています。
Edgeの場合は「TabWindowClass」クラスの子ウィンドウになっています。

プログラムとしては「IEAuto.FindBrowser("Google")」でタイトルにGoogleを含むものを検索してIHTMLDoucmentを取得します。
あとは、exeScriptでJavaScriptをたたくことが可能ですが、関数の仕様として戻り値を取得することはできません。

そのため、JavaScriptから値をVBAに返す場合は、テスト用の要素に書き込むといいでしょう。

なお、すくなくとも当方の環境だとexeScriptはEdgeだとアクセス違反になりました。

参考

Cant create HTML document from Hwnd using C#
https://stackoverflow.com/questions/20873885/cant-create-html-document-from-hwnd-using-c-sharp

【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)
https://www.ka-net.org/blog/?p=7921

12
18
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
12
18

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?