在IE web对话框窗口中自动生成HTML文档?

以下是我的结论(为没有包括我找到关键部分的各种链接而道歉-如果我能重新找到它们,将在稍后添加)

编辑: 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

声明

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

用法示例:

'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