Return focus to ThisWorkbook.Activesheet after XMLHTTP60 file download

Question

Situation:

I am unable to return focus to the Excel application after initiating a file download.

My usual tricks of AppActivate and Application.hwnd , when working between applications, don't seem to be working this time. I haven't had a problem doing this before so don't know if I am being particularly dense today, or, it is because I am involving a browser for the first time. I suspect it is the former.

Questions:

1) Can any one see where I am going wrong (why focus does not shift back to Excel)?

2) More importantly: Is there a way to download files in the background, using the default browser, keeping the focus on ThisWorkbook and thereby avoiding the issue altogether?

I am using a workaround of SendKeys "%{F4}" immediately after the download, at present, to close the browser and so am defaulting back to Excel.

Note: The default browser in my case is Google Chrome but clearly could be any browser.

What I have tried:

1) From @user1452705; focus didn't shift:

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) Then I tried:

ThisWorkbook.Activate 'No shift in focus

Windows(ThisWorkbook.Name).Activate 'Nothing happened

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

3) AppActivate using Title as actually displayed in Window:

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

4) More desperate attempts:

AppActivate Application.Caption 'Nothing happened

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

AppActivate ThisWorkbook.Name 'Nothing happened

AppActivate "Microsoft Excel" 'Invalid proc call

4) Finally, the current version of my code is using @ChipPearson's sub ActivateExcel , which also has no effect:

Module 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

Module 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

Additional references:

1) Toggle between Excel and IE

2) VBA API declarations. Bring window to front , regardless of application ; link also in main body

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

Generally you don't need `HTMLDocument` here, so Excel will not lost the focus. Try to extract the file downloading URL from the response parsing it by simple splitting (check [this](https://stackoverflow.com/a/35782811/2165759) or [this](https://stackoverflow.com/a/41538937/2165759)), after that make another one XHR to download target file content, and save it with `ADODB.Stream` (check [this](https://stackoverflow.com/a/41729562/2165759)). — omegastripes, Jan 30 '18 at 19:29
@omegastripes Thanks for this. Too a bit of reading to get where you were coming from but got there. Much obliged. — QHarr, Feb 13 '18 at 10:03
So, have you came up with the code? It would be nice to answer with working solution. — omegastripes, Feb 13 '18 at 10:29
@omegastripes I did, though actually for a different scenario. Used your process so I could, maybe later today, adapt to use as answer for this. — QHarr, Feb 13 '18 at 10:38

score 1 · Accepted Answer · answered Feb 13 '18 at 12:02

Thanks to @OmegaStripes and @FlorentB for their input.

Using @OmegaStripes suggested method I:

Use XMLHTTP to get binary response content
Convert to UTF-8
Parse to extract the required URL
Use a new XMLHTTP to download binary
Use ADODB.Stream to write out file

Works a treat and no problems with shift in focus.

Notes: For step 3, I used the approach by @KarstenW to write the string , the converted responseText string, out to a txt file for examination to determine how to access the URL of interest.

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

robertocm · Answer 2 · 2018-04-30T19:03:43.030

1

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

In summary, change this:

AppActivate "Microsoft Excel"

to

AppActivate "Excel

Note: a pause before the command can help (at least in my case):

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

edited Apr 30 '18 at 19:03

answered Apr 30 '18 at 18:23

robertocm

124
6

I think this yielded the same problem for me I'm afraid though this has been useful in the past. +1 AppActivate is supposed to use what is in the window title but it is buggy. – QHarr Apr 30 '18 at 18:30

Return focus to ThisWorkbook.Activesheet after XMLHTTP60 file download

2 Answers2

Linked