2

No rodapé deste site "http://sdro.ons.org.br/SDRO/DIARIO/index.htm" tem um ícone que faz o download de um arquivo .xls. Eu precisava clicar nele e salvar o arquivo, mas não sei como fazê-lo.

Segue o código, adaptado de um outro fornecido pelo danieltakeshi, das duas formas que eu tentei fazer (a segunda marcada com *) nas duas a página abre e não acontece nada.

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 Resposta 1

2

Código

Teste este código que irá salvar o arquivo no mesmo diretório que o arquivo Excel.

'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

Explicação

A explicação de parte do código está neste link.

Download de Arquivo

A diferença é que a função downloadFile foi adicionada, esta é usada para realizar o download do arquivo e foi retirada do SOen e créditos para: ashleedawg

CStr

E a função CStr() é usada para converter para String.

1
  • Daniel, já ocnsegui realizar de outra forma. Mas obrigado pela ajuda! 21/03/2018 às 18:34

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .