Aceess VBA-从网站获取数据的子例程在调试模式下有效,但在运行时不起作用

时间:2018-12-30 19:11:24

标签: html vba web-scraping access

我想从增值税号(波兰的NIP号码)获取客户数据。 我无法弄清楚为什么以下所示的代码仅在调试模式下以及在按F5时才起作用,但是我在“ button.click”行中设置了断点。 当我不使用换行符运行它时,它不会打印任何数据。

在此先感谢您提供处理建议。

以下过程中使用的睡眠方法如下:

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub IE_GetDataFromSite()

    Dim IE As SHDocVw.InternetExplorer
    Dim HTMLDoc As MSHTML.HTMLDocument
    Dim HTMLInput As MSHTML.IHTMLElement
    Dim button As MSHTML.IHTMLElement
    Dim row As MSHTML.IHTMLElement
    Dim rows As MSHTML.IHTMLElementCollection
    Dim cell As MSHTML.IHTMLElement

    Set IE = New SHDocVw.InternetExplorer


        IE.Visible = False
        IE.navigate "https://wyszukiwarkaregon.stat.gov.pl/appBIR/index.aspx"

        Do While IE.ReadyState <> READYSTATE_COMPLETE
            DoEvents
        Loop

        Set HTMLDoc = IE.Document
        Set HTMLInput = HTMLDoc.getElementById("txtNip")
            HTMLInput.value = "9542583988"

        Set button = HTMLDoc.getElementById("btnSzukaj")
        button.Click

        Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
            DoEvents
        Loop

        Sleep (1000)

        Set HTMLDoc = IE.Document

        Set rows = HTMLDoc.getElementsByClassName("tabelaZbiorczaAltRow")
                    For Each row In rows
                        Debug.Print row.innerText, row.className
                        If row.className = "tabelaZbiorczaAltRow" Then
                            For Each cell In row.Children

                                Debug.Print cell.innerText

                            Next cell
                        End If
                    Next row
        IE.Quit
End Sub

1 个答案:

答案 0 :(得分:0)

输入数字后允许短暂的暂停,并循环播放直到出现表格

Option Explicit

Public Sub GetInfo()
    Dim ie As New InternetExplorer, td As Object
    Dim tr As Object, table As Object, t As Date
    Const MAX_WAIT_SEC As Long = 5

    With ie
        .Visible = True
        .navigate "https://wyszukiwarkaregon.stat.gov.pl/appBIR/index.aspx"

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

        .document.querySelector("#txtNip").Value = "9542583988"

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

        .document.querySelector("#btnSzukaj").Click

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set table = .document.querySelector("table.tabelaZbiorcza")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While table Is Nothing
        If Not table Is Nothing Then
            For Each tr In table.getElementsByTagName("tr")
                For Each td In tr.getElementsByTagName("td")
                    Debug.Print td.innerText
                Next
            Next
        End If
        .Quit
    End With
End Sub