Handling of internet explorer using VBA

Asked

Viewed 4,893 times

2

At the bottom of this site "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" has an icon that downloads a file .xls. I needed to click on it and save the file, but I don’t know how to do it.

It follows the code, adapted from another provided by danieltakeshi, of the two forms I tried to do (the second marked *) in the two the page opens and nothing happens.

Sub TesteBusca()

    Dim IE As Object
    Dim sWindows As Object
    Dim sJanelas As Object
    Dim sDados As String
    Dim doc As MSHTML.HTMLDocument

    Set IE = CreateObject("InternetExplorer.Application")

    IE.navigate "http://sdro.ons.org.br/SDRO/DIARIO/index.htm"
    IE.Visible = True

    EsperaIE IE, 2000

    'Debug.Print IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a").innerText
    i = 1
    For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a")
    'Debug.Print EXTRAIRELEMENTO(link.href, 8, "/")
        If EXTRAIRELEMENTO(link.href, 7, "/") = "DIARIO_18-03-2018.xlsx" Then
            i = i + 1


            link.Click
             EsperaIE IE, 2000
            If i = 2 Then Exit For
        End If

    Next link    

*    i = 1
*    For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a")
*        If link.getAttribute("scr") = "../img/exportxls.gif" Then
 *           i = i + 1

  *          link.Click
   *          EsperaIE IE, 2000
    *        If i = 2 Then Exit For
     *   End If

    *Next link   

End Sub

Public Sub EsperaIE(IE As Object, Optional time As Long = 250)
'Código de: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set
Dim i As Long
Do
    Sleep time
    Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _
                vbCrLf & vbTab & "Busy: " & CStr(IE.Busy)
    i = i + 1
Loop Until IE.READYSTATE = 4 Or Not IE.Busy
End Sub

Function EXTRAIRELEMENTO(Txt As String, n, Separator As String) As String
    On Error GoTo ErrHandler:
    EXTRAIRELEMENTO = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1)
    Exit Function
ErrHandler:
    ' error handling code
    MsgBox "Erro, veriique os dados de entrada."
    EXTRAIRELEMENTO = CVErr(xlErrNA)
    On Error GoTo 0
End Function

1 answer

1


Code

Test this code that will save the file in the same directory as the Excel file.

'Declara função Sleep
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub TesteBusca()

    Dim IE As Object
    Dim link As Variant

    Set IE = CreateObject("InternetExplorer.Application")

    IE.navigate "http://sdro.ons.org.br/SDRO/DIARIO/index.htm"
    IE.Visible = True

    EsperaIE IE, 2000

    'Debug.Print IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a").innerText
    i = 1
    For Each link In IE.document.getElementsByTagName("frame")(1).contentDocument.getElementsByTagName("a")
    ContaCaracter = Len(link) - Len(Replace(link, "/", ""))
    Elemento = EXTRAIRELEMENTO(CStr(link), ContaCaracter + 1, "/")
        Debug.Print link
        If InStr(1, Elemento, ".xlsx") > 0 Then
            i = i + 1
            'link.Click
             EsperaIE IE, 2000
            If i = 2 Then Exit For
        End If

    Next link
    Debug.Print link
    downloadFile CStr(link), ThisWorkbook.Path & "\" & Elemento

End Sub

Public Sub EsperaIE(IE As Object, Optional time As Long = 250)
'Código de: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set
Dim i As Long
Do
    Sleep time
    Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _
                vbCrLf & vbTab & "Busy: " & CStr(IE.Busy)
    i = i + 1
Loop Until IE.READYSTATE = 4 Or Not IE.Busy
End Sub

Function EXTRAIRELEMENTO(Txt As String, n, Separator As String) As String
    On Error GoTo ErrHandler:
    EXTRAIRELEMENTO = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1)
    Exit Function
ErrHandler:
    ' error handling code
    MsgBox "Erro, veriique os dados de entrada."
    EXTRAIRELEMENTO = CVErr(xlErrNA)
    On Error GoTo 0
End Function

Sub downloadFile(url As String, filePath As String)
'https://stackoverflow.com/questions/49198016/opening-the-downloaded-file-from-a-website?noredirect=1&lq=1
'ashleedawg
    Dim WinHttpReq As Object, attempts As Integer, oStream
    attempts = 3
    On Error GoTo TryAgain
TryAgain:
    attempts = attempts - 1
    Err.Clear
    If attempts > 0 Then
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", url, False
        WinHttpReq.send

        If WinHttpReq.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write WinHttpReq.responseBody
            oStream.SaveToFile filePath, 2 ' 1 = no overwrite, 2 = overwrite
            oStream.Close
            MsgBox "Arquivo baixado para:" & vbLf & filePath
        End If
    Else
        MsgBox "Falhou."
    End If

End Sub

Explanation

The explanation of part of the code is at this link.

File Download

The difference is that the function downloadFile was added, this is used to download the file and was removed from Soen and credits to: ashleedawg

Cstr

And the function CStr() is used to convert to String.

  • Daniel, already ocnsegui perform otherwise. But thanks for the help!

Browser other questions tagged

You are not signed in. Login or sign up in order to post.