VBA Internet automation code not working when ie.Visible = False

Question

Good morning, I am struggling to find information on a problem which seems to not have much information available on the internet - that is the "frame notification bar" in internet explorer ( the little yellow window that asks you if you want to "save" or "open" a file downloaded).

I will cut to the chase, the issue I am having is that my code works when an internet explorer visibility is set to true, but doesn't work when visibility is set to false. I have stepped through the code in both situations to see what changes, and noticed the handle for the frame notification bar changes value but other than that all are the same. The relevant code is:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Sub StartIE()
    Dim appIE As Object
    Dim URLString As String
    Dim HTMLdoc, btn As Object
    Set appIE = CreateObject("internetexplorer.application") ' create an instance of internet explorer


    With appIE
        .Navigate "https://analytics.twitter.com/user" 'this url wont work for you. you will need to have your own twitter account on twitter analytics, and copy the link to the "tweets" page
        .Visible = True ' and show the IE
    End With
    Do While appIE.Busy Or (appIE.READYSTATE <> 4) ' wait until IE has finished loading

        DoEvents
    Loop

    URLString = appIE.LocationURL

    Set HTMLdoc = appIE.document
    Set btn = HTMLdoc.getElementsByClassName("btn btn-default ladda-button")(0) 'finds the export data button
    btn.Click
    Do While appIE.Busy Or (appIE.READYSTATE <> 4) ' wait until IE has finished loading
            DoEvents
    Loop

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



    Dim hwnd As LongPtr, h As LongPtr


    Dim o As IUIAutomation ' The following steps are used to download a csv file from a webpage
    Dim e As IUIAutomationElement
    Set o = New CUIAutomation
    h = appIE.hwnd
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString) ' we must find the first frame notification handle
    If h = 0 Then Exit Sub
    Set e = o.ElementFromHandle(ByVal h) 
    Dim iCnd As IUIAutomationCondition
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save") 
    Dim Button As IUIAutomationElement
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke


    h = appIE.hwnd
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    If h = 0 Then Exit Sub

    Set e = o.ElementFromHandle(ByVal h)
    Dim iCnd2 As IUIAutomationCondition
    Set iCnd2 = o.CreatePropertyCondition(UIA_NamePropertyId, "Open") ' similar to the above snippet, except for the second stage of the frame notification window

    Dim Button2 As IUIAutomationElement
    Set Button2 = e.FindFirst(TreeScope_Subtree, iCnd2)
    Dim InvokePattern2 As IUIAutomationInvokePattern
    Set InvokePattern2 = Button2.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern2.Invoke

End Sub

Out of this code, the snippet where I believe the issue is occurring is in:

    Dim o As IUIAutomation ' The following steps are used to download a csv file from a webpage
    Dim e As IUIAutomationElement
    Set o = New CUIAutomation
    h = appIE.hwnd
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString) ' we must find the first frame notification handle
    If h = 0 Then Exit Sub
    Set e = o.ElementFromHandle(ByVal h) 
    Dim iCnd As IUIAutomationCondition
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save") 
    Dim Button As IUIAutomationElement
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

Can anyone provide me with an idea of why this might be happening, and how I might fix it? I know I'm asking alot already but I would really love an explanation alongside any fix as I am trying to improve my understanding, and find it will be beneficial to others in a similar situation :)

Thankyou in advance.

Answer 1

Take a look at the below example:

Option Explicit

Sub SaveTweetsToCsv()

    Dim sAuthToken As String
    Dim sUserName As String
    Dim sStartTime As String
    Dim sEndTime As String
    Dim aHeaders
    Dim sUrl As String
    Dim sParams As String
    Dim sResp As String

    ' Set init data
    sUserName = "myusername" ' Your username
    sStartTime = "1517184000000" ' UNIX time with milliseconds
    sEndTime = "1519603199999"
    ' Check saved auth token
    sAuthToken = GetEnvVar("user", "tw_auth_token")
    ' Retrieve auth token if missing
    If sAuthToken = "" Then sAuthToken = GetAuthToken()
    ' Prepare request parameters
    sUrl = "https://analytics.twitter.com/user/" & sUserName & "/tweets/"
    sParams = "start_time=" & sStartTime & "&end_time=" & sEndTime & "&lang=en"
    ' Set request auth token header
    aHeaders = Array(Array("cookie", "auth_token=" & sAuthToken))
    ' Make request and check availability
    Do
        ' Retrieve status
        WinHTTPRequest "POST", sUrl & "export.json?" & sParams, _
            "", _
            aHeaders, _
            "", _
            "", _
            sResp, _
            ""
        ' Check if auth token is invalid
        If InStr(sResp, "403 Forbidden") > 0 Then sAuthToken = GetAuthToken()
        ' Check report availability
        If InStr(sResp, """status"":""Available""") > 0 Then Exit Do
        DoEvents
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    ' Retrieve CSV content
    WinHTTPRequest "GET", sUrl & "bundle?" & sParams, _
        "", _
        aHeaders, _
        "", _
        "", _
        sResp, _
        ""
    ' Save CSV
    WriteTextFile sResp, CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\result.csv", -1
    MsgBox "Completed"

End Sub

Function GetAuthToken() As String

    Dim sLogin As String
    Dim sPassword As String
    Dim sHdrs As String
    Dim sResp As String
    Dim aSetHeaders
    Dim aTmp
    Dim sToken As String
    Dim aPayload
    Dim sPayload As String
    Dim aOptions
    Dim i As Long

    If MsgBox("Login", vbOKCancel) = vbCancel Then End
    sLogin = "mylogin" ' Your login
    sPassword = "mypassword" ' Your password
    ' Retrieve login form
    WinHTTPRequest "GET", "https://twitter.com/", _
        "", _
        "", _
        "", _
        sHdrs, _
        sResp, _
        ""
    ' Extract cookies from headers
    ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sHdrs, aSetHeaders
    ' Extract authenticity_token from login form
    aTmp = Split(sResp, """ name=""authenticity_token""", 2)
    If UBound(aTmp) = 0 Then MsgBox "Failed to get authenticity token": End
    sToken = Mid(aTmp(0), InStrRev(aTmp(0), """") + 1)
    ' Prepare payload for login request
    aPayload = Array( _
        Array("session[username_or_email]", sLogin), _
        Array("session[password]", sPassword), _
        Array("remember_me", "1"), _
        Array("return_to_ssl", "true"), _
        Array("scribe_log", ""), _
        Array("redirect_after_login", "/"), _
        Array("authenticity_token", sToken), _
        Array("ui_metrics", "") _
    )
    For i = 0 To UBound(aPayload)
        aPayload(i) = EncodeUriComponent((aPayload(i)(0))) & "=" & EncodeUriComponent((aPayload(i)(1)))
    Next
    sPayload = Join(aPayload, "&")
    ' Add web form headers
    PushItem aSetHeaders, Array("Content-Type", "application/x-www-form-urlencoded")
    PushItem aSetHeaders, Array("Content-Length", Len(sPayload))
    ' WinHTTP option disabling redirections
    aOptions = Array(Array(6, False)) ' redirectoins disabled
    ' Login request
    WinHTTPRequest "POST", "https://twitter.com/sessions", _
        aOptions, _
        aSetHeaders, _
        sPayload, _
        sHdrs, _
        sResp, _
        ""
    ' Extract auth_token from received headers
    aTmp = Split(sHdrs, "auth_token=", 2)
    If UBound(aTmp) = 0 Then MsgBox "Failed to get auth token": End
    GetAuthToken = Split(aTmp(1), ";", 2)(0)
    ' Save auth token to user env var for further usage
    SetEnvVar "user", "tw_auth_token", GetAuthToken
    MsgBox "Auth token retrieved successfully"

End Function

Sub SetEnvVar(sEnv As String, sName As String, sValue As String)

    CreateObject("WSCript.Shell").Environment(sEnv).Item(sName) = sValue

End Sub

Function GetEnvVar(sEnv As String, sName As String) As String

    GetEnvVar = CreateObject("WSCript.Shell").Environment(sEnv).Item(sName)

End Function

Sub WinHTTPRequest(sMethod, sUrl, aSetOptions, aSetHeaders, vFormData, sRespHeaders, sRespText, aRespBody)

    Dim aItem

    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open sMethod, sUrl, False
        If IsArray(aSetOptions) Then
            For Each aItem In aSetOptions
                .Option(aItem(0)) = aItem(1)
            Next
        End If
        If IsArray(aSetHeaders) Then
            For Each aItem In aSetHeaders
                .SetRequestHeader aItem(0), aItem(1)
            Next
        End If
        .send (vFormData)
        sRespHeaders = .GetAllResponseHeaders
        sRespText = .ResponseText
        aRespBody = .ResponseBody
    End With
End Sub

Sub ParseResponse(sPattern, sResponse, aData, Optional bAppend As Boolean = True, Optional bGlobal As Boolean = True, Optional bMultiLine As Boolean = True, Optional bIgnoreCase As Boolean = True)

    Dim oMatch
    Dim aTmp()
    Dim sSubMatch

    If Not (IsArray(aData) And bAppend) Then aData = Array()
    With CreateObject("VBScript.RegExp")
        .Global = bGlobal
        .MultiLine = bMultiLine
        .IgnoreCase = bIgnoreCase
        .Pattern = sPattern
        For Each oMatch In .Execute(sResponse)
            If oMatch.SubMatches.Count = 1 Then
                PushItem aData, oMatch.SubMatches(0)
            Else
                aTmp = Array()
                For Each sSubMatch In oMatch.SubMatches
                    PushItem aTmp, sSubMatch
                Next
                PushItem aData, aTmp
            End If
        Next
    End With

End Sub

Sub PushItem(aData, vItem, Optional bAppend As Boolean = True)

    If Not (IsArray(aData) And bAppend) Then aData = Array()
    ReDim Preserve aData(UBound(aData) + 1)
    aData(UBound(aData)) = vItem

End Sub

Function EncodeUriComponent(sText As String) As String

    Static objHtmlfile As Object

    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(sText)

End Function

Sub WriteTextFile(sContent As String, sPath As String, lFormat As Long)

    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 2, True, lFormat)
        .Write sContent
        .Close
    End With

End Sub

Note. Excessive auth token requests are detected by the web site as automated, that may lead to the account to be blocked, in that case you will need to enter the captcha and confirm your phone number to receive a code by SMS. That is why auth token is saved to environment variable once it is retrieved, for further usage.