vba - Automating the HTML document in an IE web dialog window?

Question

Posting this question do I can provide a full example for anyone like me who needed to figure this out...

Occasionally when automating IE you may be faced with a pop-up dialog which you need to interact with: I'm specifically talking here about the modal dialog which is IE-specific, and opened using showModalDialog

https://msdn.microsoft.com/en-us/library/ms536759(v=vs.85).aspx

These dialogs are different from the typical "pop-over" dialogs or ones based on window.open() - although they contain HTML, there's no easy way to get a reference to the document contained within the dialog. For example iterating through the windows under the Windows shell does not find this type of dialog.

I figured there must be some way to solve this problem using the Windows API, and I found a bunch of relevant pieces via Google, but no complete and self-contained example.

See my answer for how I solved my specific use case - should be easily re-used if you need something similar.

Answer 1

Here's what I ended up with (apologies for not including the various links where I found the key parts - will add later if I can re-find them)

Edit: https://social.msdn.microsoft.com/Forums/en-US/baf3cb64-8858-4d2d-9d7b-eaee76919256/modify-the-code-obtained-from-the-internet-explorerserver-hwnd-handle?forum=vbgeneral

Declarations (if you have 64-bit Office installed you will need to make some adjustments)

Option Explicit

' Requires: VBA project reference to "Microsoft HTML Object Library"

Private Const SMTO_ABORTIFHUNG = &H2
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

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

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

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
    (ByVal hWnd As Long) As Long

Private Declare Function GetWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Declare Function IsWindowVisible Lib "user32" _
    (ByVal hWnd As Long) As Boolean

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, _
   lParam As Any, _
   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 UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

Example usage:

'An example of how to use this approach - other subs below should not need adjusting
Sub DialogDemo()

    Const DLG_TITLE = "User Info -- Webpage Dialog" '<< the dialog title
    Dim doc As IHTMLDocument

    Set doc = GetIEDialogDocument(DLG_TITLE)

    If Not doc Is Nothing Then
        'Debug.Print doc.body.innerHTML
        doc.getElementById("password_id").Value = "password"
        doc.getElementById("Notes_id").Value = "notes go here"
        doc.getElementById("b_Ok_id").Click '<< click OK
    Else
        MsgBox "Dialog Window '" & DLG_TITLE & "' was not found!", vbOKOnly + vbExclamation
    End If
End Sub

'Given an IE dialog window title, find the window and return a reference
'   to the embedded HTML document object
Function GetIEDialogDocument(dialogTitle As String) As IHTMLDocument
    Dim lhWndP As Long, lhWndC As Long, doc As IHTMLDocument
    'find the IE dialog window given its title
    If GetHandleFromPartialCaption(lhWndP, dialogTitle) Then
        Debug.Print "Found dialog window - " & dialogTitle & "(" & TheClassName(lhWndP) & ")"
        lhWndC = GetWindow(lhWndP, GW_CHILD)  'Find Child
        If lhWndC > 0 Then
            If TheClassName(lhWndC) = "Internet Explorer_Server" Then
                Debug.Print , "getting the document..."
                Set doc = IEDOMFromhWnd(lhWndC)
            End If
        End If
    Else
        Debug.Print "Window '" & dialogTitle & "' not found!"
    End If
    Set GetIEDialogDocument = doc
End Function

' IEDOMFromhWnd
' Returns the IHTMLDocument interface from a WebBrowser window
' hWnd - Window handle of the control
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
    Dim IID_IHTMLDocument As UUID
    Dim hWndChild As Long
    Dim lRes As Long
    Dim lMsg As Long
    Dim hr As Long

    If hWnd <> 0 Then

        lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT") ' Register the message
        SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes ' Get the object pointer

        If lRes Then
            With IID_IHTMLDocument ' Initialize the interface ID
                .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
            ' Get the object from lRes (note - returns the object via the last parameter)
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
        End If
   End If 'hWnd<>0
End Function

'utilty function for getting the classname given a window handle
Function TheClassName(lhWnd As Long)
    Dim strText As String, lngRet As Long
    strText = String$(100, Chr$(0))
    lngRet = GetClassName(lhWnd, strText, 100)
    TheClassName = Left$(strText, lngRet)
End Function

Private Function GetHandleFromPartialCaption(ByRef lWnd As Long, _
                                             ByVal sCaption As String) As Boolean
    Dim lhWndP As Long, sStr As String

    GetHandleFromPartialCaption = False
    lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        sStr = Left$(sStr, Len(sStr) - 1)
        If Len(sStr) > 2 Then
            If UCase(sStr) Like "*ARG*" Then Debug.Print sStr
        End If
        If InStr(1, sStr, sCaption) > 0 Then
            GetHandleFromPartialCaption = True
            lWnd = lhWndP
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
    Loop
End Function