如何将数据放在对话框的空白字段中

时间:2018-08-05 23:28:20

标签: vba excel-vba internet-explorer web-scraping automation

我创建了一个工具,该工具单击IE中网页上的项目,然后弹出网页对话框,我需要使用VBA将数据放入对话框的空白字段中。

我无法手动(右键单击)查看对话框的源代码。该网页和URL是机密的,所以我不能分享。我正在使用FindWindow函数来查找网页对话框,它成功返回HWND值。这是我的代码:

Sub FindWebDialog()

    Dim hwnd As Long

    hwnd = FindWindow(vbNullString, "Live Payments -- Webpage Dialog")
    If hwnd <> 0 Then
        'get the htmldocument
    Else
        MsgBox "no dialog found"
    End If

End Sub

我认为,如果我得到FindWindow的返回值,则可以从那里检索网页对话框的源代码,然后使用它来查找空白字段的确切位置。我想知道如何使用HWND获取网页对话框的源代码。

2 个答案:

答案 0 :(得分:0)

不清楚该对话框实际上是什么。它是网页文档的一部分,还是在新的IE弹出窗口中打开?是模态的吗?

请对对话框进行截图,以便同时显示网页和对话框标题。您可以擦拭屏幕截图上的敏感字符(例如,画图),然后将其上传。

还尝试使用以下代码检查已打开的IE窗口:

Option Explicit

Sub Test()

    Dim oWnd As Object

    For Each oWnd In CreateObject("Shell.Application").Windows
        On Error Resume Next
        If TypeName(oWnd.Document) = "HTMLDocument" Then
            Wait oWnd
            Debug.Print "URL   = " & oWnd.Document.Location
            Debug.Print "HWND  = " & oWnd.Hwnd
            Debug.Print "Title = " & oWnd.Document.Title
            Debug.Print "Error = " & Err.Number
            Debug.Print
        End If
    Next
    Debug.Print "Completed"

End Sub

Sub Wait(oIE As Object)

    Do While oIE.Busy Or oIE.readyState <> 4
        DoEvents
    Loop
    Do While oIE.Document.readyState <> "complete"
        DoEvents
    Loop

End Sub

执行以下步骤:执行操作以显示对话框,使用您在问题中发布的代码查找HWND,然后运行上面显示的代码并共享输出。

这两个截图,输出清单以及FindWindow的HWND都应该使事情变得更清楚。

答案 1 :(得分:0)

很抱歉,您没有回答上述问题,一直在搜索其他网站寻求帮助。 使用上面的代码,未找到对话框,当在IE父窗口中单击链接时,IE对话框打开,并且它是模态的。问题是只有findwindow可以找到对话框,并且findwindow仅返回HWND(windows句柄是Long Integer)。我发现一些代码使用HWND作为参考来获取对话框的htmldocument。 (如下)

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

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 EnumChildWindows Lib "user32" ( _
   ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   lParam 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 Const SMTO_ABORTIFHUNG = &H2

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
   ByVal lResult As Long, _
   riid As UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

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

Public 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

      If Not IsIEServerWindow(hWnd) Then

         ' Find a child IE server window
         EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd

      End If

      If hWnd <> 0 Then

         ' Register the message
         lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")

         ' Get the object pointer
         Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                 SMTO_ABORTIFHUNG, 1000, lRes)

         If lRes Then

            ' Initialize the interface ID
            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

            ' Get the object from lRes
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)

         End If

      End If

   End If

End Function

Public Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
    Dim lRes As Long
    Dim sClassName As String

    'Initialize the buffer
    sClassName = String$(100, 0)

    'Get the window class name
    lRes = GetClassName(hWnd, sClassName, Len(sClassName))
    sClassName = Left$(sClassName, lRes)

    IsIEServerWindow = StrComp(sClassName, _
                    "Internet Explorer_Server", _
                    vbTextCompare) = 0
End Function

并使用此代码检索htmldocument,以便我可以搜索所需的文本字段的相应元素。

Sub HtmlDocFromHandle()
  Dim myHandle As Long, iHtml2 As IHTMLDocument2
  Dim ieobj As Object

  myHandle = FindWindow(vbNullString, "TITLE OF THE WINDOW")
  If myHandle <> 0 Then
    Set ihtml2 = IEDOMFromhWnd(hForm)
    Set ieobj = ihtml2.activeElement
    Debug.Print ieobj.document
  Else
    MsgBox "Window not found"
  End If
End Function