Question

情况：

启动文件下载后，我无法将焦点返回到Excel应用程序。

在应用程序之间工作时，AppActivate和Application.hwnd的常用技巧似乎不会正常工作。我之前没有遇到过这样的问题所以不知道我今天是否特别密集，或者是因为我第一次涉及浏览器。我怀疑它是前者。

问题：

1）任何人都可以看到我出错的地方（为什么焦点不会转回Excel）？

2）更重要的是：有没有办法在后台下载文件，使用默认浏览器，将重点放在ThisWorkbook上，从而完全避免这个问题？

我目前在下载后立即使用SendKeys "%{F4}"的解决方法关闭浏览器，因此默认返回Excel。

注意：在我的情况下，默认浏览器是谷歌浏览器，但显然可以是任何浏览器。

我尝试过：

1）来自@ user1452705;焦点没有转变：

Public Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long

Public Sub Bring_to_front()
    Dim setFocus As Long
    ThisWorkbook.Worksheets("Sheet1").Activate
    setfocus = SetForegroundWindow(Application.hwnd)
End Sub

2）然后我尝试了：

ThisWorkbook.Activate 'No shift in focus

Windows(ThisWorkbook.Name).Activate 'Nothing happened

Application.Windows(ThisWorkbook.Name & " - Excel").Activate 'Subscript out of range

3）AppActivate使用在Window中实际显示的标题：

AppActivate "AmbSYS_testingv14.xlsm" & " - Excel" 'Nothing happened

4）更加绝望的尝试：

AppActivate Application.Caption 'Nothing happened

AppActivate ThisWorkbook.Name & " - Excel" 'Nothing happened

AppActivate ThisWorkbook.Name 'Nothing happened

AppActivate "Microsoft Excel" 'Invalid proc call

4）最后，我的代码的当前版本使用@ ChipPearson的子ActivateExcel，这也没有效果：

第1单元：

Public Sub DownloadFiles()
'Tools > ref> MS XML and HTML Object lib
    Dim http As XMLHTTP60
    Dim html As HTMLDocument

    Set http = New XMLHTTP60
    Set html = New HTMLDocument

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/ambulance-quality-indicators/ambulance-quality-indicators-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    'Test Download code
    html.getElementsByTagName("p")(4).getElementsByTagName("a")(0).Click

   ' Application.Wait Now + TimeSerial(0, 0, 3)   'pause for downloads to finish before files

   'Other code

    ActivateExcel

End Sub

第2单元：

Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modActivateExcel
' By Chip Pearson, www.cpearson.com, chip@cpearson.com
' http://www.cpearson.com/excel/ActivateExcelMain.aspx
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Window API Declarations
' These Declares MUST appear at the top of the
' code module, above and before any VBA procedures.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare PtrSafe Function BringWindowToTop Lib "user32" ( _
ByVal HWnd As Long) As Long

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

Private Declare PtrSafe Function SetFocus Lib "user32" ( _
ByVal HWnd As Long) As Long

Public Sub ActivateExcel()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ActivateExcel
' This procedure activates the main Excel application window,
' ("XLMAIN") moving it to the top of the Z-Order and sets keyboard
' focus to Excel.
'
' !!!!!!!!!!!!!!!!!!!!!!!!!
' NOTE: This will not work properly if a VBA Editor is open.
' If a VBA Editor window is open, the system will set focus
' to that window, rather than the XLMAIN window.
' !!!!!!!!!!!!!!!!!!!!!!!!!
'
' This code should be able to activate the main window of any
' application whose main window class name is known. Just change
' the value of C_MAIN_WINDOW_CLASS to the window class of the
' main application window (e.g., "OpusApp" for Word).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim Res As Long     ' General purpose Result variable
    Dim XLHWnd As Long    ' Window handle of Excel
    Const C_MAIN_WINDOW_CLASS = "XLMAIN"
    '''''''''''''''''''''''''''''''''''''''''''
    ' Get the window handle of the main
    ' Excel application window ("XLMAIN"). If
    ' more than one instance of Excel is running,
    ' you have no control over which
    ' instance's HWnd will be retrieved.
    ' Related Note: You MUST use vbNullString
    ' not an empty string "" in the call to
    ' FindWindow. When calling API functions
    ' there is a difference between vbNullString
    ' and an empty string "".
    ''''''''''''''''''''''''''''''''''''''''''
    XLHWnd = FindWindow(lpClassName:=C_MAIN_WINDOW_CLASS, _
                    lpWindowName:=vbNullString)
    If XLHWnd > 0 Then
        '''''''''''''''''''''''''''''''''''''''''
        ' If HWnd is > 0, FindWindow successfully
        ' found the Excel main application window.
        ' Move XLMAIN to the top of the
        ' Z-Order.
        '''''''''''''''''''''''''''''''''''''''''
        Res = BringWindowToTop(HWnd:=XLHWnd)
        If Res = 0 Then
            Debug.Print "Error With BringWindowToTop:  " & _
                CStr(Err.LastDllError)
        Else
            '''''''''''''''''''''''''''''''''
            ' No error.
            ' Set keyboard input focus XLMAIN
            '''''''''''''''''''''''''''''''''
            SetFocus HWnd:=XLHWnd
        End If
    Else
        '''''''''''''''''''''''''''''''''
        ' HWnd was 0. FindWindow couldn't
        ' find Excel.
        '''''''''''''''''''''''''''''''''
        Debug.Print "Can't find Excel"
    End If
End Sub

其他参考资料：

1）Toggle between Excel and IE

2）VBA API declarations. Bring window to front , regardless of application;链接也在主体

3）Return focus to excel after finishing downloading file with Internet explorer

4）Set focus back to the application window after showing userform

5）Close the application with sendkeys like ALt F4

Answer 1

感谢@OmegaStripes和@FlorentB的投入。

使用@OmegaStripes建议的方法I：

使用XMLHTTP获取二进制响应内容
转换为UTF-8
解析以提取所需的网址
使用新的XMLHTTP下载二进制文件
使用ADODB.Stream写出文件

在转移焦点时不会有任何问题。

注意：对于第3步，我使用@KarstenW的方法将字符串（转换后的responseText字符串）写入txt文件进行检查，以确定如何访问感兴趣的URL。

Option Explicit

Public Const adSaveCreateOverWrite As Byte = 2
Public Const url As String = "https://www.england.nhs.uk/statistics/statistical-work-areas/ambulance-quality-indicators/ambulance-quality-indicators-data-2017-18/"
Public Const adTypeBinary As Byte = 1
Public Const adTypeText As Byte = 2
Public Const adModeReadWrite As Byte = 3

Public Sub DownLoadFiles()

    Dim downLoadURL As String
    Dim aBody As String

    ' Download via XHR
    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", url, False
        .send
        ' Get binary response content
        aBody = BytesToString(.responseBody, "UTF-8")

    End With

    Dim respTextArr() As String
    respTextArr = Split(Split(aBody, "New AmbSYS Indicators")(0))
    downLoadURL = Split(respTextArr(UBound(respTextArr)), Chr$(34))(1)

    Dim urlArr() As String
    Dim fileName As String
    Dim bBody As Variant
    Dim sPath As String

    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", downLoadURL, False
        .send
        urlArr = Split(downLoadURL, "/")
        fileName = urlArr(UBound(urlArr))
        bBody = .responseBody
        sPath = ThisWorkbook.Path & "\" & fileName

    End With

    ' Save binary content to the xls file
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .Write bBody
        .SaveToFile sPath, adSaveCreateOverWrite
        .Close
    End With
    ' Open saved workbook
    With Workbooks.Open(sPath, , False)

    End With

End Sub

Public Function BytesToString(ByVal bytes As Variant, ByVal charset As String) As String

    With CreateObject("ADODB.Stream")
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write bytes
        .Position = 0
        .Type = adTypeText
        .charset = charset
        BytesToString = .ReadText
    End With
End Function

Answer 2

For Excel 2013 please see here a solution that worked for me

总之，改变一下：

AppActivate "Excel

到

Application.Wait (Now + TimeValue("0:00:1"))

注意：命令之前的暂停可以提供帮助（至少在我的情况下）：

{{1}}

在XMLHTTP60文件下载后将焦点返回到ThisWorkbook.Activesheet

2 个答案: