情况：
启动文件下载后，我无法将焦点返回到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
其他参考资料：
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
答案 0 :(得分：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
答案 1 :(得分：1)
For Excel 2013 please see here a solution that worked for me
总之，改变一下：
AppActivate "Excel
到
Application.Wait (Now + TimeValue("0:00:1"))
注意：命令之前的暂停可以提供帮助（至少在我的情况下）：
{{1}}