Unable to download file from Web_Web Scraping using VBA

Rajkumar_h

New Member
Joined
Oct 4, 2013
Messages
20
Hello,

This is the first time am trying out web scraping using VBA. with the help of WiseOwl blog i was able to write the below and am successful till macro clicks to download the file.

I would required help for two things:

  1. Mainly for downloading the XLS file where i presume we need to use API functionality. I have no experience in it. Collected some information on API from Mr.Excel forum (https://www.mrexcel.com/forum/excel...ng-ie-automation-using-vba-3.html#post2805320), tried it but not getting the result.
  2. Secondly when the loop completes and starts a new loop I am getting a Webpage not found error. and
  3. Thirdly if you could help me out with dynamic Shellwin.counts.


Below is the entire code for your reference:


Code:
Option Explicit


Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)


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


Public 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


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


Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long


Public Const BM_CLICK = &HF5
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
'=============================================================================================



Public Const baseURL As String = "http://wasbprbvl.corp.kjhasfdjhf-jlkahsfdlh.com/asfdsafdsaf/main.do"""




[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal IpfnCB As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal IpfnCB As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Sub Browse()


Dim IE As SHDocVw.InternetExplorer
'Dim IE As InternetExplorer
Dim ie2 As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInputU As MSHTML.IHTMLElement, HTMLInputP As MSHTML.IHTMLElement
Dim HTMLAs As MSHTML.IHTMLElementCollection, HTMLAss As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement ', HTMLRep As MSHTML.IHTMLElement
Dim HTMLTable As MSHTML.IHTMLTable
Dim Report As Variant
Dim cell As Range, x As Variant
Dim DestinationFile As Variant




Set ie2 = Nothing
Dim DataRange As Range
Dim MyArr() As Variant


Set DataRange = Range("B2").CurrentRegion


ReDim MyArr(DataRange.Cells.Count)


For Each cell In DataRange.Cells
    MyArr(x) = cell.Value
    x = x + 1
Next cell


For x = LBound(MyArr) To UBound(MyArr)


    Set IE = New SHDocVw.InternetExplorer
    
DestinationFile = "\\na1.ofc.loc\dfsusa\homedir\afdasfasfd\home\Desktop\Trial" & MyArr(x) & ".xls"
'theFolder = "\\na1.ofc.loc\dfsusa\homedir\afdasfasfd\home\Desktop\Trial"
'theFilename = MyArr(x) & ".xls"


    IE.Visible = True
    IE.navigate "abweb.corp.kjhasfdjhf-jlkahsfdlh.com/dss/scripts/warehousing.asp"
    
    Do While IE.readyState <> READYSTATE_COMPLETE
    Loop
    
    Set HTMLDoc = IE.document
    Set HTMLAs = HTMLDoc.getElementsByTagName("a")
    
    For Each HTMLA In HTMLAs
    
        Debug.Print HTMLA.getAttribute("href"), HTMLA.innerText
        If HTMLA.innerText = MyArr(x) Then
            HTMLA.Click
                Application.Wait Now + TimeValue("00:00:3")
                IE.navigate "wasbprbvl.corp.kjhasfdjhf-jlkahsfdlh.com/asfdsafdsaf/Login"
                Do While IE.readyState <> READYSTATE_COMPLETE
                Loop
            IE.document.forms("Login").elements("j_username").Value = "Y921304"
            IE.document.forms("Login").elements("j_password").Value = "India@2020"
            
            
            Set tagNames = HTMLDoc.getElementsByTagName("INPUT")
            i = 0
            While i < tagNames.length
                If tagNames(i).Type = "submit" And tagNames(i).Value = "Submit" Then
                    Set objelement = tagNames(i)
                    objelement.Click
                    Application.Wait Now + TimeValue("00:00:05")
                    GoTo clickCode
                End If
                i = i + 1
            Wend
clickCode:
    Set ie2 = New SHDocVw.InternetExplorer
    
    Dim shellWins As ShellWindows
    
    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(3)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Reports" Then
            HTMLAA.Click
            GoTo NextReport
        End If
    Next


NextReport:


    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(3)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Shipment Reports" Then
            HTMLAA.Click
            GoTo shipmentReport
        End If
    Next
shipmentReport:
    
    'Application.Wait Now + TimeValue("00:00:03")
    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(3)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Inbound Shipment Report" Then
            HTMLAA.Click
            GoTo InboundShip
        End If
    Next
InboundShip:


    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(3)
    End If
    
    Set HTMLDocs = ie2.document
    
    With ie2.document
        .forms("foInboundShipmentPrompt").getElementsByTagName("Select")("lstShipmentType").Value = "5"
        .forms("foInboundShipmentPrompt").getElementsByTagName("Select")("lstSelectByDate").Value = "1"
        .getElementsByName("txtStartDate")(0).Value = Format(Range("E2"), "Short Date")
        .getElementsByName("txtEndDate")(0).Value = Format(Range("E3"), "Short Date")
    End With


    Set taggNames = ie2.document.getElementsByTagName("INPUT")
            i = 0
            While i < taggNames.length
                If taggNames(i).Name = "cmdGenerateXLS" And taggNames(i).Value = "Generate XLS" Then
                    Set objelement = taggNames(i)
                    objelement.Click
                    Application.Wait Now + TimeValue("00:00:10")
                    GoTo NextCode
                End If
                i = i + 1
            Wend
NextCode:


'Click Save as button to save the file in system
                
                
'                Report = Application.GetSaveAsFilename("Inbound Shipment Report_Report_2019FEB08_0304.xls", "Excel Files (*.xls), *.xls")






            If URLDownloadToFile(0, "http://wasbprbvl.corp.kjhasfdjhf-jlkahsfdlh.com/asfdsafdsaf/welcomeFiles/index.jsp?device_type=DT", DestinationFile, 0, 0) = 0 Then
                Debug.Print "File Download Started", URLDownloadToFile(0, "http://wasbprbvl.corp.kjhasfdjhf-jlkahsfdlh.com/asfdsafdsaf/main.do", DestinationFile, 0, 0)
'                Application.SendKeys "%{O}"
            Else
                Debug.Print "File Download not Started"
            End If
                
                            
                File_Download_Click_Save
                    
                Save_As_Set_Filename "\\na1.ofc.loc\dfsusa\homedir\afdasfasfd\home\Desktop\Trial", MyArr(x) & ".xls"
                
                Save_As_Click_Save
                   
                Download_complete_Click_Close
    
    Debug.Print "Finished"
    
        GoTo Loopnext
        End If
        
            
    Next HTMLA
    
    'close the IE session
Loopnext:
    IE.Quit
    ie2.Quit


    Set IE = Nothing
    Set ie2 = Nothing


Next x
End Sub








Private Sub File_Download_Click_Save()
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "File_Download_Click_Save"
    
    'Find the File Download window, waiting a maximum of 30 seconds for it to appear
    
    timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow("[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=32770]#32770[/URL] ", "File Download")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    
    Debug.Print "   File Download window "; Hex(hWnd)
    
    If hWnd Then


        'Find the child Save button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Click the Save button
        
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If


End Sub




Private Sub Test_Save_As_Set_Filename()
    'Test setting the Save As filename.  The Save As window must be displayed before running this
    Dim theFolder As String, theFilename As String
    theFolder = "\\na1.ofc.loc\dfsusa\homedir\afdasfasfd\home\Desktop\Trial"
    theFilename = "test " & Format(Now, "hh_mm_ss") & ".xls"
    Save_As_Set_Filename theFolder, theFilename
End Sub




Private Sub Save_As_Set_Filename(Folder As String, filename As String)


    'Populate the 'File name:' edit window in the Save As dialogue with the specified folder and/or filename.
    'If folder = "" a folder path is not prepended and therefore the default save folder is used.
    'If filename = "" the default file name (already populated) is used.
    
    'The Save As window has the following child window hierarchy:
    
    '   "Save As", [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=32770]#32770[/URL]  Dialog
    '       "FileName2011_11_11_11_00_26", ComboBoxEx32     (default value in combobox)
    '           "", ComboBox
    '               "FileName2011_11_11_11_00_26"", Edit    (default value in combobox's edit box)
    
    Dim hWnd As Long
    Dim timeout As Date
    Dim fullFilename As String
    
    Debug.Print "Save_As_Set_Filename " & Folder
    
    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
    
    timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow("[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=32770]#32770[/URL] ", "Save As")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout


    If hWnd Then
    
        SetForegroundWindow (hWnd)
        
        'Find the child ComboBoxEx32 window
        
        hWnd = FindWindowEx(hWnd, 0, "ComboBoxEx32", vbNullString)
        Debug.Print "   ComboBoxEx32 "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Find the child ComboBox window
        
        hWnd = FindWindowEx(hWnd, 0, "ComboBox", "")
        Debug.Print "   ComboBox "; Hex(hWnd)
    End If
                 
    If hWnd Then
        
        SetForegroundWindow (hWnd)


        'Find the child Edit window
        
        hWnd = FindWindowEx(hWnd, 0, "Edit", "")
        Debug.Print "   Edit "; Hex(hWnd)
    End If
    
    If hWnd Then
            
        If filename = "" Then
            'Get default filename (already populated in Edit window)
            filename = Get_Window_Text(hWnd)
        End If
       
        If Folder <> "" And Right(Folder, 1) <> "" Then Folder = Folder & ""  'if specified, ensure folder ends with \
        
        fullFilename = Folder & filename
        Debug.Print "Full filename " & fullFilename
        
        'Populate the Edit window with the full file name
        
        Sleep 200
        SendMessageByString hWnd, WM_SETTEXT, Len(fullFilename), fullFilename
    End If
    
End Sub




Private Function Get_Window_Text(hWnd As Long) As String


    'Returns the text in the specified window
    
    Dim buffer As String
    Dim length As Long
    Dim result As Long
    
    length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
    buffer = Space(length + 1)  '+1 for the null terminator
    result = SendMessage(hWnd, WM_GETTEXT, Len(buffer), ByVal buffer)
    Debug.Print "Edit File name = " & Left(buffer, length)
    Debug.Print "     length = " & length
    
    Get_Window_Text = Left(buffer, length)
    
End Function




Private Sub Save_As_Click_Save()


    'Click the Save button in the Save As dialogue
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "Save_As_Click_Save"


    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
    
    timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow(vbNullString, "Save As")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout


    If hWnd Then
    
        SetForegroundWindow (hWnd)
            
        'Get the child Save button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; hWnd
    End If
    
    If hWnd Then
        'Click the Save button
        
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
        
End Sub




Private Sub Download_complete_Click_Close()
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "Download_complete_Click_Close"
        
    'Find the Download complete window, waiting a maximum of 30 seconds for it to appear.  Timeout value is dependent on the
    'size of the download, so make it longer for bigger files
    
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow("[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=32770]#32770[/URL] ", "Download complete")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout


    Debug.Print "   Download complete window "; Hex(hWnd)
    
    If hWnd Then


        'Find the child Close button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "Close")
        Debug.Print "   Close button "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Click the Close button
        
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If


End Sub




Public Function Get_IE_Window_LB(sUrl As String, Optional sProtocol As String = "http") As Object


    'Look for an IE window or tab already open at the specified URL (excluding sub paths) and, if found, return that browser
    'as an InternetExplorer object.  Otherwise return Nothing


    Dim sDomain As String
    Dim Shell As Object
    Dim IE As Object
    Dim i As Variant 'Integer
    
    If Left(sUrl, Len(sProtocol)) <> sProtocol Then sUrl = sProtocol & sUrl
    sDomain = Left(sUrl, InStr(Len(sProtocol) + 1, sUrl, "/"))


    Set Shell = CreateObject("Shell.Application")
    
    i = 0
    Set Get_IE_Window_LB = Nothing
    While i < Shell.Windows.Count And Get_IE_Window_LB Is Nothing


        Set IE = Shell.Windows.Item(i)
        If Not IE Is Nothing Then
            If TypeName(IE.document) = "HTMLDocument" Then
                If InStr(IE.LocationURL, sDomain) > 0 Then
                    Set Get_IE_Window_LB = IE
                End If
            End If
        End If
        i = i + 1
    Wend
    
End Function




Required an experts help to resolve this.

Waiting for reply from an expert soon.

Thanks in advance,

Raj Gerard
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
I wrote that code for IE8. It doesn't work for IE11 because IE11 uses the Download Notification Bar.

If you're using IE11 then try the code at https://www.mrexcel.com/forum/gener...le-download-ie11-post5221771.html#post5221771. You would automate IE to the point where it displays the Download Notification Bar at the bottom of the window and then call the IE_Download_File_Using_UIAutomation function with suitable arguments, as described in that post and shown in the code.
 
Upvote 0
Hi John,

Thanks for your reply and the code.

I tried adding the same to my code but not sure why am getting debug in the below line of code:

Code:
IE_Click_Tab_Like IE.hWnd, "*wasbprbvl.corp.anheuser-busch.com*"        downloadStatus = IE_Download_File_Using_UIAutomation(IE.hWnd, saveInFolder, saveAsFileName, replaceExistingFile, downloadResult)
        Debug.Print "Download status = " & downloadStatus

Would require your help to modify the code accordingly. please help.

Attaching the updated code for your reference :

Code:
Public Const baseURL As String = "http://wasbprbvl.corp.anheuser-busch.com/WMSBrwy/main.do"""








[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal IpfnCB As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal IpfnCB As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Sub Browse()


Dim IE As SHDocVw.InternetExplorer
'Dim IE As InternetExplorer
Dim ie2 As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInputU As MSHTML.IHTMLElement, HTMLInputP As MSHTML.IHTMLElement
Dim HTMLAs As MSHTML.IHTMLElementCollection, HTMLAss As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement ', HTMLRep As MSHTML.IHTMLElement
Dim HTMLTable As MSHTML.IHTMLTable
Dim Report As Variant
Dim cell As Range, x As Variant
'Dim DestinationFile As Variant
Dim URL As String
Dim downloadResult As String, downloadStatus As Boolean




Set ie2 = Nothing
Dim DataRange As Range
Dim MyArr() As Variant


Set DataRange = Range("B2").CurrentRegion


ReDim MyArr(DataRange.Cells.Count)


For Each cell In DataRange.Cells
    MyArr(x) = cell.Value
    x = x + 1
Next cell


For x = LBound(MyArr) To UBound(MyArr)


    Set IE = New SHDocVw.InternetExplorer
    
saveInFolder = ""                           'Save in IE11's default download folder
saveInFolder = "\\na1.ofc.loc\dfsusa\HomeDir\Y921737\Home\Data\My Documents\Desktop 2018\Rajendran\Santhosh"          'Save in this folder
saveAsFileName = ""                         'Save As the file name provided by web site
'saveAsFileName = "My Csv Data"              'Save As this file name
replaceExistingFile = True


saveAsFileName = MyArr(x) & ".xls"
'theFolder = "\\na1.ofc.loc\dfsusa\homedir\Y921737\home\Desktop\Trial"
'theFilename = MyArr(x) & ".xls"


    IE.Visible = True
    IE.navigate "abweb.corp.anheuser-busch.com/dss/scripts/warehousing.asp"
    
    Do While IE.readyState <> READYSTATE_COMPLETE
    Loop
    
    Set HTMLDoc = IE.document
    Set HTMLAs = HTMLDoc.getElementsByTagName("a")
    
    For Each HTMLA In HTMLAs
    
        Debug.Print HTMLA.getAttribute("href"), HTMLA.innerText
        If HTMLA.innerText = MyArr(x) Then
            HTMLA.Click
                Application.Wait Now + TimeValue("00:00:3")
                IE.navigate "wasbprbvl.corp.anheuser-busch.com/WMSBrwy/Login"
                Do While IE.readyState <> READYSTATE_COMPLETE
                Loop
            IE.document.forms("Login").elements("j_username").Value = "Y921304"
            IE.document.forms("Login").elements("j_password").Value = "India@2020"
            
            
            Set tagNames = HTMLDoc.getElementsByTagName("INPUT")
            i = 0
            While i < tagNames.length
                If tagNames(i).Type = "submit" And tagNames(i).Value = "Submit" Then
                    Set objelement = tagNames(i)
                    objelement.Click
                    Application.Wait Now + TimeValue("00:00:05")
                    GoTo clickCode
                End If
                i = i + 1
            Wend
clickCode:
    Set ie2 = New SHDocVw.InternetExplorer
    
    Dim shellWins As ShellWindows
    
    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(2)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Reports" Then
            HTMLAA.Click
            GoTo NextReport
        End If
    Next


NextReport:


    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(2)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Shipment Reports" Then
            HTMLAA.Click
            GoTo shipmentReport
        End If
    Next
shipmentReport:
    
    'Application.Wait Now + TimeValue("00:00:03")
    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(2)
    End If
    
    Set HTMLDocs = ie2.document
    Set HTMLAss = HTMLDocs.getElementsByTagName("a")
    For Each HTMLAA In HTMLAss
        If HTMLAA.innerText = "Inbound Shipment Report" Then
            HTMLAA.Click
            GoTo InboundShip
        End If
    Next
InboundShip:


    Set shellWins = New ShellWindows
    
    If shellWins.Count > 0 Then
        Set ie2 = shellWins.Item(2)
    End If
    
    Set HTMLDocs = ie2.document
    
    With ie2.document
        .forms("foInboundShipmentPrompt").getElementsByTagName("Select")("lstShipmentType").Value = "5"
        .forms("foInboundShipmentPrompt").getElementsByTagName("Select")("lstSelectByDate").Value = "1"
        .getElementsByName("txtStartDate")(0).Value = Format(Range("E2"), "Short Date")
        .getElementsByName("txtEndDate")(0).Value = Format(Range("E3"), "Short Date")
    End With


    Set taggNames = ie2.document.getElementsByTagName("INPUT")
            i = 0
            While i < taggNames.length
                If taggNames(i).Name = "cmdGenerateXLS" And taggNames(i).Value = "Generate XLS" Then
                    Set objelement = taggNames(i)
                    objelement.Click
                    Application.Wait Now + TimeValue("00:00:10")
                    GoTo NextCode
                End If
                i = i + 1
            Wend
NextCode:
    
    
        URL = "http://wasbprbvl.corp.anheuser-busch.com/WMSBrwy/main.do"
        


        IE_Click_Tab_Like IE.hWnd, "*wasbprbvl.corp.anheuser-busch.com*"
        downloadStatus = IE_Download_File_Using_UIAutomation(IE.hWnd, saveInFolder, saveAsFileName, replaceExistingFile, downloadResult)
        Debug.Print "Download status = " & downloadStatus
        MsgBox "Download result = " & downloadResult
        
    
    Debug.Print "Finished"
    
        GoTo Loopnext
        End If
        
            
    Next HTMLA
    
    'close the IE session
Loopnext:
    'IE.Quit
    'ie2.Quit


    Set IE = Nothing
    Set ie2 = Nothing
'https://www.ozgrid.com/forum/forum/other-software-applications/excel-and-web-browsers-help/133706-click-on-a-button-link-javascript-on-a-website
Next x
End Sub








[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Public Function IE_Download_File_Using_UIAutomation(IEhwnd As LongPtr, ByVal saveInFolder As String, ByVal saveAsFileName As String, ByVal replaceExistingFile As Boolean, ByRef downloadResult As String) As Boolean
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Public Function IE_Download_File_Using_UIAutomation(IEhwnd As Long, ByVal saveInFolder As String, ByVal saveAsFileName As String, ByVal replaceExistingFile As Boolean, ByRef downloadResult As String) As Boolean
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


    'Automate IE11's Download Notification Bar in the active tab, by clicking the Save As item, downloading the file and closing the Notification Bar.
    'The IE option 'Notify when downloads complete' must be enabled.
    '
    'Parameters:
    'IEhwnd                 The handle of the IE window. The Download Notification Bar must be displayed in the active tab.
    '                       If necessary, call IE_Click_Tab_Like to activate the required tab before calling this function.
    'saveInFolder           The folder path where the downloaded file will be saved.  Specify "" to save the file in IE's default download folder.
    'saveAsFileName         The file name which the downloaded file will be given.  If file extension is omitted, the file extension provided by
    '                       the web site is used. Specify "" to use the file name provided by the web site.
    'replaceExistingFile    True to replace the file if it already exists; False to overwrite the file
    'downloadResult         Output string returned to the caller showing whether the file was successfully download or not, including the file name of the
    '                       downloaded file (including its path if saveInFolder was specified).
    '
    'Function return value  True: the file was downloaded; False: the file was not downloaded
    
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim hWnd As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hWnd As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Dim UIAutomation As IUIAutomation
    Dim DesktopRoot As IUIAutomationElement
    Dim FrameNotificationBarPane As IUIAutomationElement
    Dim Button As IUIAutomationElement
    Dim NotificationBarText As IUIAutomationElement
    Dim SplitButtons As IUIAutomationElementArray
    Dim DownArrow As IUIAutomationElement
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim ContextMenu As IUIAutomationElement
    Dim SaveAsMenuItem As IUIAutomationElement
    Dim SaveAsWindow As IUIAutomationElement
    Dim FileNameInput As IUIAutomationElement
    Dim FileNameInputPattern As IUIAutomationValuePattern, FileNameInputPatternLegacy As IUIAutomationLegacyIAccessiblePattern
    Dim ConfirmSaveAsWindow As IUIAutomationElement
    Dim ConfirmSaveAsWindowText As IUIAutomationElement
    Dim SaveAsWarningWindow As IUIAutomationElement, SaveAsWarningText As IUIAutomationElement
    Dim NotificationToolbar As IUIAutomationElement
    Dim ControlName As IUIAutomationCondition, ControlType As IUIAutomationCondition, NameAndType As IUIAutomationCondition
    Dim TreeWalker As IUIAutomationTreeWalker
    Dim defaultFileName As String, fullFileName As String
    Dim ConfirmSaveAsWindowTextString As String
    Dim SaveAsWarningTextString As String
    Dim NotificationBarTextString As String, p1 As Long, p2 As Long
    Dim timeout As Date
    Dim downloaded As Boolean
    Dim destCell As Range, numRows As Long
    
    Const DebugMode As Boolean = True
    
    IE_Download_File_Using_UIAutomation = True
    downloadResult = ""
    
    'If specified, ensure folder ends with \
    
    If saveInFolder <> "" And Right(saveInFolder, 1) <> "" Then saveInFolder = saveInFolder & ""
    
    'Create main UIAutomation object
    
    Set UIAutomation = New CUIAutomation
    
    'Find the IE11 Frame Notification Bar, waiting until it exists
    
    Do
        hWnd = FindWindowEx(IEhwnd, 0, "Frame Notification Bar", vbNullString)
        DoEvents
        Sleep 200
    Loop While hWnd = 0
    If DebugMode Then Debug.Print Time; "Frame Notification Bar " & hWnd


    'Get the Frame Notification Bar pane from the window frame
    'Class         = Frame Notification Bar
    'Ctrl type     = UIA_PaneControlTypeId


    Set FrameNotificationBarPane = UIAutomation.ElementFromHandle(ByVal hWnd)
    'DumpElement FrameNotificationBarPane
        
    If DebugMode Then
        With Worksheets(1)
            .Cells.Clear
            Set destCell = .Range("A1")
        End With
        destCell.Value = "  FrameNotificationBarPane children"
        numRows = UIElements_To_Cells(UIAutomation, FrameNotificationBarPane, destCell.Offset(1))
        Set destCell = destCell.Offset(numRows + 2)
    End If


    'Find the Notification tool bar, a child of the Frame Notification Bar pane, waiting until it exists
    'Name:          "Notification"
    'ControlType:   UIA_ToolBarControlTypeId


    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Notification")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ToolBarControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
    Do
        Set NotificationToolbar = FrameNotificationBarPane.FindFirst(TreeScope_Children, NameAndType)
        Sleep 200
        If DebugMode Then Debug.Print Time; "Find Notification tool bar"
        DoEvents
    Loop While NotificationToolbar Is Nothing
    If DebugMode Then
        destCell.Value = "  NotificationToolbar children"
        numRows = UIElements_To_Cells(UIAutomation, NotificationToolbar, destCell.Offset(1))
        Set destCell = destCell.Offset(numRows + 2)
    End If
    
    'Find the Notification tool bar text element and extract the default file name from it
    'Name:          "Notification bar Text"
    'ControlType:   UIA_TextControlTypeId
    'Value.Value:   "Do you want to open or save xxxx.csv from yyyy.com?"
        
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Notification bar Text")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
    Set NotificationBarText = FrameNotificationBarPane.FindFirst(TreeScope_Descendants, NameAndType)
    NotificationBarTextString = NotificationBarText.GetCurrentPropertyValue(UIA_ValueValuePropertyId)
    p1 = InStr(NotificationBarTextString, "Do you want to open or save ")
    If p1 = 1 Then
        p1 = p1 + Len("Do you want to open or save ")
        p2 = InStr(p1, NotificationBarTextString, " from ")
        defaultFileName = Mid(NotificationBarTextString, p1, p2 - p1)
    Else
        defaultFileName = ""
    End If
    
    'Get 2nd split button, which is the Down arrow next to Save in the Notification tool bar
    
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_SplitButtonControlTypeId)
    Set SplitButtons = NotificationToolbar.FindAll(TreeScope_Descendants, ControlType)
    Set DownArrow = SplitButtons.GetElement(1)
        
    'When the Down arrow is clicked, 3 items are displayed: Save; Save as; Save and open.  These 3 items are children of an element
    'with the following properties:
    '
    'Name:          "Context"
    'ControlType:   UIA_MenuControlTypeId
    '
    'IMPORTANT - this Context menu is a child of the Desktop element, NOT the Notification tool bar, nor the Down arrow
    
    'Create criteria to find the Context menu
    
    Set DesktopRoot = UIAutomation.GetRootElement
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Context")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_MenuControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
       
    'Click the Down arrow repeatedly, until the Context menu, containing the 3 items (Save; Save as; Save and open) exists.
    'Note - Because the Context menu is a child of the Desktop element, the FindFirst call specifies TreeScope_Children,
    'not TreeScope_Descendants, to reduce the number of elements searched.
    'See [url]https://docs.microsoft.com/en-us/win...ment-findfirst[/url]
    
    Set InvokePattern = DownArrow.GetCurrentPattern(UIA_InvokePatternId)
    Do
        DownArrow.SetFocus
        InvokePattern.Invoke
        DoEvents
        Sleep 200
        Set ContextMenu = DesktopRoot.FindFirst(TreeScope_Children, NameAndType)
    Loop While ContextMenu Is Nothing
    
    If DebugMode Then
        destCell.Value = "  ContextMenu children"
        numRows = UIElements_To_Cells(UIAutomation, ContextMenu, destCell.Offset(1))
        Set destCell = destCell.Offset(numRows + 2)
    End If
        
    'Find the Save as item in the Context menu
    'Name:          "Save as"
    'ControlType:   UIA_MenuItemControlTypeId
    
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Save as")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_MenuItemControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
    Set SaveAsMenuItem = ContextMenu.FindFirst(TreeScope_Children, NameAndType)
        
    'Click the Save as item to display the Save As dialogue window
    
    Set InvokePattern = SaveAsMenuItem.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
    
    'Find the Save As dialogue window, which is a child of the Desktop, looping until it exists.
    'Again, the FindFirst specifies TreeScope_Children to reduce the number of elements searched.
    'Name:          "Save As"
    'ControlType:   UIA_WindowControlTypeId
    
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Save As")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
    Do
        Set SaveAsWindow = DesktopRoot.FindFirst(TreeScope_Children, NameAndType)
        DoEvents
        Sleep 100
    Loop While SaveAsWindow Is Nothing
            
    If DebugMode Then
        destCell.Value = "  SaveAsWindow children"
        numRows = UIElements_To_Cells(UIAutomation, SaveAsWindow, destCell.Offset(1))
        Set destCell = destCell.Offset(numRows + 2)
    End If
            
    'If the caller has specified either the folder or the file name, then populate the file name input box in the Save As window
    
    If saveInFolder <> "" Or saveAsFileName <> "" Then
    
        If saveAsFileName = "" Then
            'The caller has not specified the file name, so use the default file name from the Notification bar
            saveAsFileName = defaultFileName
        Else
            'If the caller has not specified an extension in the file name, append the extension from the default file name
            p1 = InStrRev(saveAsFileName, ".")
            If p1 = 0 Then
                saveAsFileName = saveAsFileName & Mid(defaultFileName, InStrRev(defaultFileName, "."))
            ElseIf p1 = Len(saveAsFileName) Then
                saveAsFileName = saveAsFileName & Mid(defaultFileName, InStrRev(defaultFileName, ".") + 1)
            End If
        End If
        
        'Construct the full file name
        
        fullFileName = saveInFolder & saveAsFileName
        
        'Create criteria to find the file name input box, which is a child of the Save As window
        'Name:          "File name:"
        'ControlType:   UIA_EditControlTypeId
    
        Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "File name:")
        Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_EditControlTypeId)
        Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
        'Find the file name input box
        
        Set FileNameInput = SaveAsWindow.FindFirst(TreeScope_Descendants, NameAndType)
        
        'Put the full file name in the input box, using IUIAutomationValuePattern


        Set FileNameInputPattern = FileNameInput.GetCurrentPattern(UIA_ValuePatternId)
        FileNameInput.SetFocus
        FileNameInputPattern.SetValue fullFileName
        
        'Alternative code to put the full file name in the input box using IUIAutomationLegacyIAccessiblePattern.
        'Same effect as using UIA_ValuePatternId above.
        '
        'Set FileNameInputPatternLegacy = FileNameInput.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        'FileNameInputPatternLegacy.Select 1 '1=SELFLAG_TAKEFOCUS
        'FileNameInputPatternLegacy.SetValue fullFileName
        
        'If the Save button is clicked now, the Save As thinks the default file name is still being used.
        'To overcome this, and use the specified file name, we put a single space at the start of the input box with SendKeys
        
        SendKeys " ", True          'press space key
             
    Else
    
        'The caller has specified neither the folder nor the file name, so use the default file name provided by the remote site.
        'The file, if downloaded, will be saved in IE's default download folder
        
        fullFileName = defaultFileName
    
    End If
    
    'Create criteria to find the Save button
    'Name:          "Save"
    'ControlType:   UIA_ButtonControlTypeId
    
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Save")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
    
    'Find the Save button, a child of the Save As window
    
    Set Button = SaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        
    'Click the Save button
    
    Button.SetFocus
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
    If DebugMode Then Debug.Print Time; "Save clicked"
        
    'Logical steps after clicking the Save button
    '
    'Find the Confirm Save As window, if it exists
    'If the Confirm Save As window was found Then
    '   If replaceExistingFile Then
    '       Click Yes
    '       downloaded = True
    '   Else
    '       Click No
    '       Click Cancel in Notification Bar
    '       downloaded = False
    '   End If
    'Else
    '   downloaded = True
    'End If
    'If downloaded Then
    '   Wait until Notification Bar contains "download has completed"
    '   Extract downloaded file name from Notification Bar
    'End If
    'Close Notification Bar
        
    
    'Create criteria to find the Confirm Save As dialogue window, if it exists
    'Name:          "Confirm Save As"
    'ControlType:   UIA_WindowControlTypeId
    
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Confirm Save As")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
    'Find the Confirm Save As window, a child of the Save As window, waiting a maximum of 3 seconds
    
    timeout = DateAdd("s", 3, Now)
    Do
        Set ConfirmSaveAsWindow = SaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        Sleep 200
        If DebugMode Then Debug.Print Time; "Find Confirm Save As"
        DoEvents
    Loop While ConfirmSaveAsWindow Is Nothing And Now < timeout
       
    If Not ConfirmSaveAsWindow Is Nothing Then
        
        'The Confirm Save As window exists, so click the Yes or No button depending on the replaceExistingFile flag
    
        If replaceExistingFile Then
        
            'Criteria to find Yes button
            'Name:          "Yes"
            'ControlType:   UIA_ButtonControlTypeId
            
            Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Yes")
            Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
            Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
            'Find the Yes button
            
            Set Button = ConfirmSaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        
            'Click the Yes button
            
            Button.SetFocus
            Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
            InvokePattern.Invoke
            If DebugMode Then Debug.Print Time; "Yes clicked"
        
            downloaded = True


        Else 'replaceExistingFile = False
        
            'Extract the text warning from the Confirm Save As window
            
            Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId)
            Set ConfirmSaveAsWindowText = ConfirmSaveAsWindow.FindFirst(TreeScope_Children, ControlType)
            ConfirmSaveAsWindowTextString = ConfirmSaveAsWindowText.GetCurrentPropertyValue(UIA_NamePropertyId)
        
            'Criteria to find No button
            'Name:          "No"
            'ControlType:   UIA_ButtonControlTypeId
            
            Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "No")
            Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
            Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
            'Find the No button, waiting until it exists
            
            Set Button = ConfirmSaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        
            'Click the No button
            
            Button.SetFocus
            Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
            InvokePattern.Invoke
            If DebugMode Then Debug.Print Time; "No clicked"
                        
            downloadResult = fullFileName & " NOT DOWNLOADED - " & ConfirmSaveAsWindowTextString & " - replaceExistingFile = False"
            IE_Download_File_Using_UIAutomation = False
            
        End If
    
    Else
    
        'The Confirm Save As window doesn't exist.  This means that either the file was downloaded, or a Save As warning is
        'being displayed, giving the reason why it was not downloaded.
        
        'Criteria to find Save As warning window
        'Name:          "Save As"
        'ControlType:   UIA_WindowControlTypeId
        
        Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Save As")
        Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
        Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)


        'Find the Save As warning window - a child of the main Save As window


        Set SaveAsWarningWindow = SaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        
        If Not SaveAsWarningWindow Is Nothing Then
        
            'The Save As warning window exists, so extract the text warning from it
            
            Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId)
            Set SaveAsWarningText = SaveAsWarningWindow.FindFirst(TreeScope_Children, ControlType)
            SaveAsWarningTextString = SaveAsWarningText.GetCurrentPropertyValue(UIA_NamePropertyId)
            
            'Create criteria to find the OK button in the Save As warning window
            'Name:          "OK"
            'ControlType:   UIA_ButtonControlTypeId
            
            Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "OK")
            Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
            Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
            
            'Find the OK button - a child of the Save As warning window
            
            Set Button = SaveAsWarningWindow.FindFirst(TreeScope_Children, NameAndType)
            
            'Click the OK button
            
            Button.SetFocus
            Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
            InvokePattern.Invoke
            If DebugMode Then Debug.Print Time; "OK clicked"
            
            IE_Download_File_Using_UIAutomation = False
            downloadResult = fullFileName & " - NOT DOWNLOADED - " & SaveAsWarningTextString
            
        Else
        
            'The Save As warning window doesn't exist, so the file was downloaded
            
            IE_Download_File_Using_UIAutomation = True
            
        End If
            
    End If
    
    If IE_Download_File_Using_UIAutomation = True Then
    
        If DebugMode Then
            destCell.Value = "  FrameNotificationBarPane children"
            numRows = UIElements_To_Cells(UIAutomation, FrameNotificationBarPane, destCell.Offset(1))
            Set destCell = destCell.Offset(numRows + 2)
        End If
    
        'Create criteria to find the "Notification bar Text" element
        'Name:          "Notification bar Text"
        'ControlType:   UIA_TextControlTypeId
        'Value.Value:   The xxxx yyyy.zzz download has completed.
        
        Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Notification bar Text")
        Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId)
        Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
        'Find the Notification bar Text element in the Frame Notification Bar pane and wait until it contains "download has completed"
        
        NotificationBarTextString = ""
        Do
            Set NotificationBarText = FrameNotificationBarPane.FindFirst(TreeScope_Descendants, NameAndType)
            Sleep 200
            DoEvents
            If Not NotificationBarText Is Nothing Then
                NotificationBarTextString = NotificationBarText.GetCurrentPropertyValue(UIA_ValueValuePropertyId)
            End If
            If DebugMode Then Debug.Print Time; NotificationBarTextString
        Loop Until InStr(NotificationBarTextString, "download has completed")


        'Extract file name from Notification bar text, e.g. "The xxxx yyyy.zzz download has completed."
        
        p1 = InStr(NotificationBarTextString, "The ") + Len("The ")
        p2 = InStr(p1, NotificationBarTextString, " download has completed")
        
        Debug.Print "Notification Bar downloaded = " & Mid(NotificationBarTextString, p1, p2 - p1)
        Debug.Print "Full file name = " & fullFileName
        downloadResult = fullFileName & " - SUCCESSFULLY DOWNLOADED"
        
    Else
    
        'Not downloaded, so click the Cancel button in the Save As window
            
        'Create criteria to find the Cancel button in the Save As window
        'Name:          "Cancel"
        'ControlType:   UIA_ButtonControlTypeId
        
        Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Cancel")
        Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
        Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
        'Find the Cancel button, waiting until it exists
        
        Set Button = SaveAsWindow.FindFirst(TreeScope_Children, NameAndType)
        
        'Click the Cancel button
        
        Button.SetFocus
        Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
        If DebugMode Then Debug.Print Time; "Cancel clicked"


    End If
             
    'Create criteria to find the Close (X) button on the Notification pane
    'Name:          "Close"
    'ControlType:   UIA_ButtonControlTypeId
    
    Set ControlName = UIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Close")
    Set ControlType = UIAutomation.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
    Set NameAndType = UIAutomation.CreateAndCondition(ControlName, ControlType)
        
    'Find the Close button in the IE Download Notification Bar
    
    Set Button = FrameNotificationBarPane.FindFirst(TreeScope_Descendants, NameAndType)
    
    'Click the Close button
    
    Button.SetFocus
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
    If DebugMode Then Debug.Print Time; "Close clicked"
                 
End Function




'This finds all TabItemControls of the IE element and loops through them looking for the tab item whose CurrentName property matches the specified tab name.
'If found, it activates that tab.  Uses the Like operator, so wildcards can be used (see - [url]https://docs.microsoft.com/en-us/off.../like-operator[/url])
'to specify the tab name to be found and activated.
'This is useful because sometimes although the visible the tab name - shown when hovering over the tab - may be "xxxxx", the actual tab name
'according to UIAutomation is "xxxxx Tab Group 1".


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
Public Sub IE_Click_Tab_Like(IEhwnd As LongPtr, findTabName As String)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Public Sub IE_Click_Tab_Like(IEhwnd As Long, findTabName As String)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
   
    Dim UIauto As IUIAutomation
    Dim IEwindow As IUIAutomationElement, IEtab As IUIAutomationElement
    Dim IEtabs As IUIAutomationElementArray
    Dim tabItemCondition As IUIAutomationCondition
    Dim IEtabPattern As IUIAutomationLegacyIAccessiblePattern
    Dim i As Long
    
    'Create UIAutomation object
    
    Set UIauto = New CUIAutomation
    
    'Get Internet Explorer UIAutomation element
    
    Set IEwindow = UIauto.ElementFromHandle(ByVal IEhwnd)
    
    'Create condition to find a TabItemControl
    
    Set tabItemCondition = UIauto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TabItemControlTypeId)
 
    'Find all tabs
    
    Set IEtabs = IEwindow.FindAll(TreeScope_Descendants, tabItemCondition)
    
    'Look for the tab which matches the specified tab name
    
    Set IEtab = Nothing
    i = 0
    While i < IEtabs.length And IEtab Is Nothing
        Debug.Print i; IEtabs.GetElement(i).CurrentName
        If LCase(IEtabs.GetElement(i).CurrentName) Like LCase(findTabName) Then Set IEtab = IEtabs.GetElement(i)
        i = i + 1
    Wend
        
    If Not IEtab Is Nothing Then
    
        'Access the legacy pattern of the IE tab, which has the DoDefaultAction method (Click)
    
        Set IEtabPattern = IEtab.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        IEwindow.SetFocus   'optional - brings the IE window to the foreground
        IEtabPattern.DoDefaultAction
    
    Else
    
        MsgBox "IE tab with name '" & findTabName & "' not found"
        
    End If
        
    Set IEtabPattern = Nothing
    Set IEtab = Nothing
    Set IEwindow = Nothing
    Set UIauto = Nothing
    
End Sub




Public Sub DumpElement(UIAutoElem As IUIAutomationElement)
    Dim ct As Long
    ct = Get_UIA_PropertyValue(UIAutoElem, UIA_ControlTypePropertyId)
    Debug.Print "----------------"
    Debug.Print "Name                 = " & Get_UIA_PropertyValue(UIAutoElem, UIA_NamePropertyId)
    Debug.Print "Class                = " & Get_UIA_PropertyValue(UIAutoElem, UIA_ClassNamePropertyId)
    Debug.Print "ControlType          = " & Get_UIA_ControlType(ct) & " (0x" & Hex(ct) & ")"
    Debug.Print "LocalisedControlType = " & Get_UIA_PropertyValue(UIAutoElem, UIA_LocalizedControlTypePropertyId)
    Debug.Print "Value                = " & Get_UIA_PropertyValue(UIAutoElem, UIA_ValueValuePropertyId)
    Debug.Print "Handle               = " & Get_UIA_PropertyValue(UIAutoElem, UIA_NativeWindowHandlePropertyId)
    Debug.Print "AccessKey            = " & Get_UIA_PropertyValue(UIAutoElem, UIA_AccessKeyPropertyId)
    Debug.Print "DefaultAction        = " & Get_UIA_PropertyValue(UIAutoElem, UIA_LegacyIAccessibleDefaultActionPropertyId)
    Debug.Print "Description          = " & Get_UIA_PropertyValue(UIAutoElem, UIA_FullDescriptionPropertyId)
    Debug.Print "NativeWindowHandle   = " & "0x" & Hex(Get_UIA_PropertyValue(UIAutoElem, UIA_NativeWindowHandlePropertyId))
End Sub




'Get property value for a UI element
Private Function Get_UIA_PropertyValue(UIAutoElem As IUIAutomationElement, propertyId As Long)
    
    Dim tVal As Variant
    Dim tStr As String, i As Integer
    
    tVal = UIAutoElem.GetCurrentPropertyValue(propertyId)
    
    If IsArray(tVal) Then
        tStr = tVal(0)
        For i = 1 To UBound(tVal)
            tStr = tStr & "; " & tVal(i)
        Next
        Get_UIA_PropertyValue = tStr
    Else
        Get_UIA_PropertyValue = tVal
    End If
    
End Function




'Convert a UI property id to its constant name
Private Function Get_UIA_ControlType(propertyId As Long) As String


    Dim cn As String
    
    Select Case propertyId
        Case 50040: cn = "UIA_AppBarControlTypeId"
        Case 50000: cn = "UIA_ButtonControlTypeId"
        Case 50001: cn = "UIA_CalendarControlTypeId"
        Case 50002: cn = "UIA_CheckBoxControlTypeId"
        Case 50003: cn = "UIA_ComboBoxControlTypeId"
        Case 50025: cn = "UIA_CustomControlTypeId"
        Case 50028: cn = "UIA_DataGridControlTypeId"
        Case 50029: cn = "UIA_DataItemControlTypeId"
        Case 50030: cn = "UIA_DocumentControlTypeId"
        Case 50004: cn = "UIA_EditControlTypeId"
        Case 50026: cn = "UIA_GroupControlTypeId"
        Case 50034: cn = "UIA_HeaderControlTypeId"
        Case 50035: cn = "UIA_HeaderItemControlTypeId"
        Case 50005: cn = "UIA_HyperlinkControlTypeId"
        Case 50006: cn = "UIA_ImageControlTypeId"
        Case 50008: cn = "UIA_ListControlTypeId"
        Case 50007: cn = "UIA_ListItemControlTypeId"
        Case 50010: cn = "UIA_MenuBarControlTypeId"
        Case 50009: cn = "UIA_MenuControlTypeId"
        Case 50011: cn = "UIA_MenuItemControlTypeId"
        Case 50033: cn = "UIA_PaneControlTypeId"
        Case 50012: cn = "UIA_ProgressBarControlTypeId"
        Case 50013: cn = "UIA_RadioButtonControlTypeId"
        Case 50014: cn = "UIA_ScrollBarControlTypeId"
        Case 50039: cn = "UIA_SemanticZoomControlTypeId"
        Case 50038: cn = "UIA_SeparatorControlTypeId"
        Case 50015: cn = "UIA_SliderControlTypeId"
        Case 50016: cn = "UIA_SpinnerControlTypeId"
        Case 50031: cn = "UIA_SplitButtonControlTypeId"
        Case 50017: cn = "UIA_StatusBarControlTypeId"
        Case 50018: cn = "UIA_TabControlTypeId"
        Case 50019: cn = "UIA_TabItemControlTypeId"
        Case 50036: cn = "UIA_TableControlTypeId"
        Case 50020: cn = "UIA_TextControlTypeId"
        Case 50027: cn = "UIA_ThumbControlTypeId"
        Case 50037: cn = "UIA_TitleBarControlTypeId"
        Case 50021: cn = "UIA_ToolBarControlTypeId"
        Case 50022: cn = "UIA_ToolTipControlTypeId"
        Case 50023: cn = "UIA_TreeControlTypeId"
        Case 50024: cn = "UIA_TreeItemControlTypeId"
        Case 50032: cn = "UIA_WindowControlTypeId"
        Case Else: cn = "UNKNOWN"
    End Select
    
    Get_UIA_ControlType = cn
    
End Function




'Recursively walk the hierarchy of UIAutomationElements starting at the specified parent element and output UI elements to Excel cells.


Public Function UIElements_To_Cells(UIAutomation As IUIAutomation, parentElement As IUIAutomationElement, destCell As Range) As Long


    Dim n As Long
    Dim sibling As Long
    Static TreeWalker As IUIAutomationTreeWalker
    Dim childElement As IUIAutomationElement
    Dim ct As Long
    
    n = 0
    
    If Not parentElement Is Nothing Then
    
        'Any of these tree walkers can be used
        'If TreeWalker Is Nothing Then Set TreeWalker = UIAutomation.RawViewWalker
        If TreeWalker Is Nothing Then Set TreeWalker = UIAutomation.ControlViewWalker
        'If TreeWalker Is Nothing Then Set TreeWalker = UIAutomation.ContentViewWalker
        
        Set childElement = TreeWalker.GetFirstChildElement(parentElement)
        sibling = 0
        While Not childElement Is Nothing
            ct = Get_UIA_PropertyValue(childElement, UIA_ControlTypePropertyId)
            sibling = sibling + 1
            Debug.Print "-- Sibling " & sibling
            Debug.Print "Name                 = " & Get_UIA_PropertyValue(childElement, UIA_NamePropertyId)
            Debug.Print "Class                = " & Get_UIA_PropertyValue(childElement, UIA_ClassNamePropertyId)
            Debug.Print "ControlType          = " & Get_UIA_ControlType(ct) & " (0x" & Hex(ct) & ")"
            Debug.Print "LocalisedControlType = " & Get_UIA_PropertyValue(childElement, UIA_LocalizedControlTypePropertyId)
            Debug.Print "Value                = " & Get_UIA_PropertyValue(childElement, UIA_ValueValuePropertyId)
            Debug.Print "Handle               = 0x" & Hex(Get_UIA_PropertyValue(childElement, UIA_NativeWindowHandlePropertyId))
            Debug.Print "AccessKey            = " & Get_UIA_PropertyValue(childElement, UIA_AccessKeyPropertyId)
            Debug.Print "DefaultAction        = " & Get_UIA_PropertyValue(childElement, UIA_LegacyIAccessibleDefaultActionPropertyId)
'            Debug.Print "Description          = " & Get_UIA_PropertyValue(childElement, UIA_FullDescriptionPropertyId)
            destCell.Offset(n + 0).Value = "'-- Sibling " & sibling
            destCell.Offset(n + 1).Value = "Name = " & Get_UIA_PropertyValue(childElement, UIA_NamePropertyId)
            destCell.Offset(n + 2).Value = "Class = " & Get_UIA_PropertyValue(childElement, UIA_ClassNamePropertyId)
            destCell.Offset(n + 3).Value = "ControlType = " & Get_UIA_ControlType(ct) & " (0x" & Hex(ct) & ")"
            destCell.Offset(n + 4).Value = "LocalisedControlType = " & Get_UIA_PropertyValue(childElement, UIA_LocalizedControlTypePropertyId)
            destCell.Offset(n + 5).Value = "Value = " & Get_UIA_PropertyValue(childElement, UIA_ValueValuePropertyId)
            destCell.Offset(n + 6).Value = "Handle = 0x" & Hex(Get_UIA_PropertyValue(childElement, UIA_NativeWindowHandlePropertyId))
            destCell.Offset(n + 7).Value = "AccessKey = " & Get_UIA_PropertyValue(childElement, UIA_AccessKeyPropertyId)
            destCell.Offset(n + 8).Value = "DefaultAction = " & Get_UIA_PropertyValue(childElement, UIA_LegacyIAccessibleDefaultActionPropertyId)
'            destCell.Offset(n + 9).Value = "Description = " & Get_UIA_PropertyValue(childElement, UIA_FullDescriptionPropertyId)
            
            n = n + 10 + UIElements_To_Cells(UIAutomation, childElement, destCell.Offset(n + 10, 1))
            
            Set childElement = TreeWalker.GetNextSiblingElement(childElement)
        Wend
    
    End If
    
    UIElements_To_Cells = n


End Function
 
Upvote 0
Hard to tell from the code, but you probably don't need the call to IE_Click_Tab_Like because you seem to be opening a new IE window (the Set IE = New InternetExplorer), so the required tab should be the active tab. IE_Click_Tab_Like is only needed if you're using an existing IE window with multiple tabs and the required tab is not active. Therefore remove the call. Also, make sure you're not confusing the IE and ie2 objects.

You might also want to set the DebugMode constant to False, so that the debugging functions aren't called.

The URL looks like an intranet site, so I can't really help further.
 
Upvote 0
Superb John,

thank you so so much for this wonderful code it work great after so much struggle.
Your suggestion ignited my code

One kind help, I am looking for books or material to learn on Windows API with VBA if you could help me to find one please.

After your reply to this i'll close the post.

Thanks a lot again bro

Raj Gerard
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,245
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top