Question

我一直试图让这个工作好几天了。我的情况是我有一个excel文档需要浏览一个网站作为另一个Windows用户。

我将webbrowser（IE）控制为当前用户没有问题。但是如果我以另一个用户身份启动它，我就无法启动或获取浏览器。

我在这里找到了一个示例：http://www.mvps.org/emorcillo/en/code/vb6/iedom.shtml但我无法控制页面上的元素。

以下几乎所有代码都来自该网站，除了最后一个功能测试（）。

'
' Requires: reference to "Microsoft HTML Object Library"
'
Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd 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 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

'
' 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
        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

Private 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

'
' Copy this function to a .bas module
'
Function EnumChildProc(ByVal hwnd As Long, lParam As Long) As Long
    If IsIEServerWindow(hwnd) Then
        lParam = hwnd
    Else
        EnumChildProc = 1
    End If
End Function

Function test()
    Dim hwnd As Long
    Dim doc As MSHTML.HTMLDocument

    hwnd = FindWindow("IEFrame", "Google - Internet Explorer")

    Set doc = IEDOMFromhWnd(hwnd)
    doc.execCommand "alert('test')"
End Function

这可能与我得到一个接口而不是一个实际文档的事实有关，但我不知道如何更改它。

从hwnd控制IE

0 个答案: