获取VBA中的最后一个活动窗口

时间:2013-04-28 09:52:43

标签: vba window

这不是一个重复的问题。

我有一个UserForm,它始终位于所有窗口之上。我想访问已经打开的网页的来源。我不能使用findWindow函数,因为我将打开多个浏览器窗口,标题完全相同。我只剩下一个选项 - 切换到所需的浏览器窗口,当UserForm位于顶部时单击某个按钮切换到最后一个活动窗口。之后,我将使用getForegroundWindow功能。

如何在不使用findWindowSendKeys {"%Tab"}的情况下切换到上一个活动窗口(这不起作用)?我搜索了整个互联网,但无法得到答案。

最小化表单并获取句柄正在运行,但在检查所有打开的窗口时,For循环行上的错误为No more threads can be created in the system

Function GetIEByHWND(myHWND As Long) As InternetExplorer
    Dim tempWindow As Variant
    Dim objShellWindows As New SHDocVw.ShellWindows

    Set GetIEByHWND = Nothing

    On Error GoTo errhandler

    For Each tempWindow In objShellWindows
        If InStr(tempWindow.Path, "INTERNET") Then
           If myHWND = tempWindow.hwnd Then
               Set GetIEByHWND = tempWindow
               Exit For
            End If
        End If
    Next tempWindow

    Exit Function

2 个答案:

答案 0 :(得分:2)

这是你在尝试什么?这基于THEORY 2

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Const SW_MINIMIZE = 6
Const SW_RESTORE = 9

Private Sub UserForm_Initialize()
    Application.Visible = False
End Sub

Private Sub CommandButton1_Click()
    Dim hwnd As Long, RetVal As Long

    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    RetVal = ShowWindow(hwnd, SW_MINIMIZE)

    '~~> This is required so that GetForegroundWindow
    '~~> doesn't pick up the userforms handle
    Sleep 2000

    hwnd = GetForegroundWindow()

    If GetIEByHWND(hwnd) Is Nothing Then
       MsgBox "Not Able to get the object"
    Else
       MsgBox "Was able to get the object"
    End If

    RetVal = ShowWindow(hwnd, SW_RESTORE)

    Application.Visible = True
End Sub

Function GetIEByHWND(myHWND As Long) As Object
    Dim tempWindow As Variant
    Dim objShellWindows As New SHDocVw.ShellWindows

    Set GetIEByHWND = Nothing

    For Each tempWindow In objShellWindows
        If InStr(1, tempWindow.Path, "INTERNET", vbTextCompare) Then
            If myHWND = tempWindow.hwnd Then
                Set GetIEByHWND = tempWindow
                Exit For
            End If
        End If
    Next tempWindow
End Function

<强>后续

请参阅此代码,我将与IE对象进行交互。

Private Sub CommandButton1_Click()
    Dim hwnd As Long, RetVal As Long
    Dim IE As Object

    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    RetVal = ShowWindow(hwnd, SW_MINIMIZE)

    '~~> This is required to that GetForegroundWindow
    '~~> doesn't pick up the userforms handle
    Sleep 2000

    hwnd = GetForegroundWindow()

    Set IE = GetIEByHWND(hwnd)

    If IE Is Nothing Then
       MsgBox "Not Able to get the object"
    Else
       MsgBox "Was able to get the object"

       IE.Visible = False '<~~ Interacting with IE

       Sleep 2000

       IE.Visible = True
    End If

    RetVal = ShowWindow(hwnd, SW_RESTORE)

    Application.Visible = True
End Sub

答案 1 :(得分:0)

我在GetIEbyHWND中收到错误。

尝试在两者之间进行睡眠

hwnd = GetForegroundWindow()
Sleep 2000
Set IE = GetIEByHWND(hwnd)

或者这个解决方案

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Function oGetLatestIE(sURL As String, & _
Optional sWindowTitle As String = "MyWindowtitle") As Object

Dim IE As InternetExplorer
Set IE = New InternetExplorer

IE.Navigate sURL

Dim hwnd As Long

hwnd = GetForegroundWindow() ' get latest IE window
Set IE = Nothing  ' work around for windows 7 (intranet)

i = 0
Do While i < 10 And IE Is Nothing

    i = i + 1
    Set objShellApp = CreateObject("Shell.Application")
    For Each objWindow In objShellApp.Windows
        DoEvents

        If LCase(objWindow.LocationName) = LCase(sWindowTitle) Then

            If objWindow.hwnd = hwnd Then 'active IE window if more than one with same title
            Set IE = objWindow

            End If
        End If
    Next
    DoEvents
    sleep 100
Loop

If IE Is Nothing Then
MsgBox "nothing"
Exit Function
End If

Set oGetLatestIE = IE

End Function