CODEWITHSUNDEEP
excelvbaweb-scraping
Craig
Craig

Reputation: 145

Assign the 2nd tab of IE to an object variable

Full purpose: Programatically download an XLS file from the DoD website without having to trust the certificate.

Details: I'm looking to interact with the second tab that's pulled up via my code. Currently the code keeps working with the first tab. In what I found online the last hour, this is usually done by checking the URL of the second page. The problem is that the second page has the same URL as the first. The second comes up because of a certificate issue I'm trying to circumvent. (IT can't fix the cert issue.) I would just like to be able to work with the second tab so if we have to kill the first tab, that would be fine, too. Once my links are all clicked, an IE box comes up asking what I'd like to do with the file, Open, Save, or Save As. Will I be able to control this box, too, to tell it to open (because I'm wasting my time if not)? Here's what I've got...

'http://www.exceltrainingvideos.com/how-to-follow-multiple-hyperlinks-and-extract-webpage-data/
Sub testweb()

mystart:

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Top = 0
objIE.Left = 0
objIE.Width = 1600
objIE.Height = 900
objIE.Visible = True

On Error Resume Next
objIE.Navigate ("https://www.defensetravel.dod.mil/site/pdcFiles.cfm?dir=/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/ovs19-01.xls")

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

Do
DoEvents
If Err.Number <> 0 Then
    objIE.Quit
    Set objIE = Nothing
    GoTo mystart:
End If
Loop Until objIE.ReadyState = 4

Set alllinks = objIE.document.getElementsByTagName("A")         'click year
For Each Hyperlink In alllinks
If InStr(Hyperlink.innertext, " 2019") > 0 Then
    Hyperlink.Click
Exit For
End If
Next

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

Set alllinks = objIE.document.getElementsByTagName("A")         'click file name
For Each Hyperlink In alllinks
    If InStr(Hyperlink.innertext, " ovs19-01.xls") > 0 Then         'item 45
        Hyperlink.Click
        Exit For
    End If
Next
Stop

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

Below is where I need my code to start working with the second page**

Set alllinks = objIE.document.getElementsByTagName("A")         'click More Info link
For Each Hyperlink In alllinks
    If InStr(Hyperlink.innertext, "More information") > 0 Then
        Hyperlink.Click
        Exit For
    End If
Next
Stop

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

Set alllinks = objIE.document.getElementsByTagName("A")        'click Go on to the webpage...
For Each Hyperlink In aAlllinks
    If InStr(Hyperlink.innertext, "Go on to the webpage (not recommended)") > 0 Then
        Hyperlink.Click
        Exit For
    End If
Next
Stop

objIE.Quit

End Sub

Upvotes: 1

Views: 71

Answers (1)

QHarr
QHarr

Reputation: 84465

You can use the download url direct and specify an ignore certificate warning flag

Option Explicit

Const IGNORE_SSL_ERROR_FLAG As Long = 13056
Public Sub GetFile()

    Debug.Print DownloadFile("C:\Users\User\Desktop\", "https://www.defensetravel.dod.mil/Docs/perdiem/browse/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/2019/ovs19-03.xls")

End Sub
Public Function DownloadFile(ByVal downloadFolder As String, ByVal downloadURL As String) As String
    Dim http As Object, tempArr As Variant
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "GET", downloadURL, False
    http.Option(4) = IGNORE_SSL_ERROR_FLAG
    http.send
    On Error GoTo errhand
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1
        .write http.responseBody
        tempArr = Split(downloadURL, "/")
        tempArr = tempArr(UBound(tempArr))
        .SaveToFile downloadFolder & tempArr, 2  '< "/" on enter of downloadFolder. 2 for overwrite which is Ok if no file modifications.
        .Close
    End With
    DownloadFile = downloadFolder & tempArr
    Exit Function
errhand:
    If Err.Number <> 0 Then
        Debug.Print Err.Number, Err.Description
        MsgBox "Download failed"
    End If
    DownloadFile = vbNullString
End Function

Upvotes: 1

Related Questions