Search code examples
excelvbaautomationie-automation

How to click on the download botton while exploring the PDF in IE11 through excel VBA


Sub Drop_Down() Dim objIE As Object, ele As Object, opt As Object Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = True
objIE.navigate "https://isgs-oas.isgs.illinois.edu/reports/rwservlet?oil_permit_activity"

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

Set ele = objIE.document.getElementsByTagName("INPUT")

For Each opt In ele
    If opt.getAttribute("name") = "p_YEAR" Then
        opt.Focus
        opt.Value = "2018"
        Exit For
    End If
Next opt

Set ele = objIE.document.getElementsByTagName("select")

For Each opt In ele
    If opt.getAttribute("name") = "p_MONTH" Then
        opt.Focus
        opt.Value = "January"
        Exit For
    End If
Next opt
objIE.document.forms(0).submit
Do While objIE.Busy: DoEvents: Loop

'Please help here 'Want to download the PDF file now

End Sub


Solution

  • I constructed the URL by looping through months and years and converting those to strings, which I then concatenated to the base of the URL. I guessed on what year you wanted to start with, which you'll see in the "For year =" declaration.

    List of PDFs

    Sub DownloadFile()
    Dim WinHttpReq As Object
    Dim oStream As Object
    Dim myURL As String
    Dim LocalFilePath As String
    Dim month As String
    Dim year As Integer
    Dim monthNo As Integer
    
    For year = 2010 To 2018
        For monthNo = 1 To 12
            month = MonthName(monthNo)
                myURL = "https://isgs-oas.isgs.illinois.edu/reports/rwservlet?hidden_run_parameters=oil_permit_activity&p_MONTH=" & month & "&p_YEAR=" & CStr(year)
                LocalFilePath = Environ("USERPROFILE") & "\Desktop\rwservlet\oil_permit_activity_" & month & "_" & CStr(year) & ".pdf"
    
                    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
                    WinHttpReq.Open "GET", myURL, False, "", ""  '("username", "password")
                    WinHttpReq.send
    
                    If WinHttpReq.Status = 200 Then
                        Set oStream = CreateObject("ADODB.Stream")
                        oStream.Open
                        oStream.Type = 1
                        oStream.Write WinHttpReq.responseBody
                        oStream.SaveToFile LocalFilePath, 2 ' 1 = no overwrite, 2 = overwrite
                        oStream.Close
                    End If
        Next monthNo
    Next year
    End Sub
    

    The above code worked for me, but you have to make sure the folder "rwservlet" exists on your desktop or it'll throw an error (I'm not good at error handling, but we're all learning). Otherwise you can change the LocalFilePath string.