Question

发布此问题后，我可以为需要解决此问题的像我这样的人提供一个完整的示例...

有时，在自动执行IE时，您可能会遇到需要与之交互的弹出对话框：我在这里专门谈论的是特定于IE并使用showModalDialog打开的模式对话框

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

这些对话框与典型的“弹出式”对话框或基于window.open()的对话框不同-尽管它们包含HTML，但没有简单的方法来获取对该对话框中包含的文档的引用。例如，在Windows Shell下通过Windows进行迭代时找不到这种类型的对话框。

我认为必须有某种方法可以使用Windows API解决此问题，并且我通过Google找到了许多相关的文章，但没有完整且独立的示例。

有关我如何解决特定用例的信息，请参见我的答案-如果您需要类似的东西，应轻松重用。

Answer 1

这就是我最终的想法（很抱歉，不包括我找到关键部分的各个链接-如果我可以重新找到它们，将会在以后添加）

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

声明（如果您安装了64位Office，则需要进行一些调整）

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

在IE Web对话窗口中自动执行HTML文档？

1 个答案: