时间戳

首页 > 解决方案 > 使用 VBA 从 SIDRA（巴西）获取数据

excel - 使用 VBA 从 SIDRA（巴西）获取数据

问题描述

我正在尝试使用来自巴西数据库 SIDRA 网站的数据来自动化我的工作表。

编辑：我正在尝试下载工业生产数据。提供的链接指向系列表，而不是我必须在“Variável”中选择第一个框（Índice de base fixa sem ajuste sazonal (Base: média de 2012 = 100) (Número-índice)），在“Seções e atividades industriais (CNAE 2.0)”也是第一个盒子，在“Mês”（葡萄牙语中的月份）中是所有盒子（整个时间序列）。

我有这个代码：

Private Sub FazDownload(nomed As String, nomea As String)
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object

On Error Resume Next
    Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
    If Err.Number <> 0 Then
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
    End If
On Error GoTo 0

MyFile = "http://www.sidra.ibge.gov.br/download/" & nomed & ".tsv"


WHTTP.Open "GET", MyFile, False
WHTTP.Send
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

FileNum = FreeFile
Open ThisWorkbook.Path & "\" & nomea & ".tsv" For Binary Access Write As #FileNum
    Put #FileNum, 1, FileData
Close #FileNum

End Sub

Private Sub pim_setoresindustria()

Dim ie As Object
Dim optCollection

Dim nomeper As String
nomeper = "industria" & DateDiff("s", #1/1/1970#, Now())

'Starts Internet Explorer
Set ie = CreateObject("InternetExplorer.Application")
Application.Wait (Now + TimeValue("0:00:02"))

   'Opens IE in the SIDRA webpage
    ie.Navigate "http://www.sidra.ibge.gov.br/bda/tabela/listabl.asp?z=t&o=1&i=P&c=3653"
    ie.Visible = True

    While ie.Busy
        DoEvents
    Wend

    While ie.Busy
        DoEvents
    Wend

    'Selects the characteristics of the table -- HERE IT STOPS WORKING
    Application.Wait (Now + TimeValue("0:00:02"))
        ie.Document.all("opv").Value = 1
        ie.Document.all("pov").Value = 3
        ie.Document.all("orv").Value = 3

        'Selects specific data series on the menu 
        Set optCollection = ie.Document.all("sev").Options
            For Each opt In optCollection
                opt.Selected = (opt.Value = 3135 Or opt.Value = 3134)
                'Or opt.Value = 3136 Or opt.Value = 3137 Or opt.Value = 3138)
            Next


        ie.Document.all("opc544").Value = 2
        ie.Document.all("poc544").Value = 3
        ie.Document.all("orc544").Value = 2

        ie.Document.all("opp").Value = 2
        ie.Document.all("pop").Value = 2

        ie.Document.all("compressao").Click
        ie.Document.all("compressao").Click

        ie.Document.all("formato").Value = 4
        ie.Document.all("modalidade").Value = 1
        ie.Document.all("arquivo").Value = nomeper

        ie.Document.all("gera").Click

    While ie.Busy
        DoEvents
    Wend

    'Waits 1 minute to start the download
    'Application.Wait (Now + TimeValue("0:01:00"))
    FazDownload nomeper, "pim"

ie.Quit

End Sub

该代码应该从 SIDRA 网站打开数据表，并将其复制到工作表中。它曾经可以工作（我的公司已经更新了一段时间的数据），但最近它停止了工作。编写它的人不再与我们合作，我无法理解它从 SIDRA 表中选择选项的部分。（标有 -- 这里停止工作）

有人可以帮我吗？

标签： excelvbaweb-scraping

解决方案

我将通过引入 API 调用来获得保存对话的句柄来对此进行改进。这将更加强大，但这是一个正常运行的第一个版本。

Option Explicit
Public Sub GetDownload()
    Dim IE As New InternetExplorer
    With IE
        .Visible = True
        .navigate "https://sidra.ibge.gov.br/Tabela/3653"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim variávelOpções  As Object, variávelRótulos  As Object, opção As Long
        Set variávelOpções = .document.querySelectorAll("#panel-V-collapse .sidra-toggle")
        Set variávelRótulos = .document.querySelectorAll("#panel-V-collapse [data-indice]")

        For opção = 0 To variávelOpções.Length - 1
            If opção = 0 Then
                If Not variávelOpções.item(opção).getAttribute("aria-selected") Then
                    variávelOpções.item(opção).Click
                End If
            Else
                If variávelOpções.item(opção).getAttribute("aria-selected") Then
                    variávelOpções.item(opção).Click
                End If
            End If
        Next

        Dim seçõesOuAtividades As Object, seçõesOuAtividadesRótulos As Object
        Set seçõesOuAtividades = .document.querySelectorAll("#panel-C544-collapse .sidra-toggle")
        Set seçõesOuAtividadesRótulos = .document.querySelectorAll("#panel-C544-collapse [data-indice]")

        If opção = 0 Then
            If Not seçõesOuAtividades.item(opção).getAttribute("aria-selected") Then
                seçõesOuAtividades.item(opção).Click
            End If
        Else
            If seçõesOuAtividades.item(opção).getAttribute("aria-selected") Then
                seçõesOuAtividades.item(opção).Click
            End If
        End If

        .document.querySelector("#panel-P-collapse [data-cmd=marcarTudo]").Click

        .document.querySelector("#botao-downloads").Click

        .document.querySelector("#opcao-downloads").Click

        Application.Wait Now + TimeSerial(0, 0, 10)

        Application.SendKeys "%{S}"

        Application.Wait Now + TimeSerial(0, 0, 10)

        Application.SendKeys "%{O}"

        Application.Wait Now + TimeSerial(0, 0, 5)
        .Quit
    End With

End Sub

推荐阅读