none
MANUSEIO DO EXPLORER ATRAVÉS DE VBA RRS feed

  • Pergunta

  • Boa tarde,

    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

    _________________________________________________________________________________________________________________

    Agradeço desde já,

    Leandro

                                                                
    terça-feira, 20 de março de 2018 17:18

Todas as Respostas

  • @Leandro Lazari em um outro tópico que postou:

    https://social.msdn.microsoft.com/Forums/pt-BR/cc99009f-7a14-4621-8858-9432bd0b5137/download-de-arquivos?forum=vbapt

    Eu coloquei um exemplo que faz o que voce deseja

    Segue ajustado a essa situação.

    Sub Download_XLS_Web()
        Dim miPath As String
        Dim miURL As String
        
        miPath = "C:\temp\DIARIO_18-03-2018.xlsx" 'ALTERE O DIRETORIO Q SERA SALVO
        miURL = "http://sdro.ons.org.br/SDRO/DIARIO/2018_03_18/Html/DIARIO_18-03-2018.xlsx"
        
        Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", miURL, False
        WinHttpReq.Send
        
        If VBA.Dir(miPath) <> "" Then
            VBA.Kill miPath ' deleta o arq. caso exista
        End If
        
        myURL = WinHttpReq.ResponseBody
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile miPath
        oStream.Close
        
    End Sub



    Click em propor como resposta se foi util a voce. ricardodm@outlook.com.br


    • Editado Ricardo Vba terça-feira, 20 de março de 2018 18:00
    terça-feira, 20 de março de 2018 17:59