VBA 从网站获取信息

Question

我正在用 VBA 编写代码，以便在几个网站中输入日期，然后在搜索字段中输入日期，然后获取为该日期找到的操作系统列表。

当我按 F8 键调试时，代码可以工作，但是当我运行宏时，它有时工作有时不工作。当我收到错误消息时，我只需按调试，然后按 F5 继续宏，它应该可以正常工作。问题总是出现在以下行中：

Call IE.document.GetElementsByID("........")

错误信息是：运行时错误“424”，该对象是必需的。

我认为问题在于页面未加载，但我不确定。

Sub PegarDadosListas(data As Date)

Dim contador As Integer

Dim dia As String
Dim mes As String
Dim ano As String

dia = Day(data)
mes = Month(data)
ano = Year(data)

Range("K2").End(xlToRight).Offset(0, 1) = data

Call Extra(dia, mes, ano)
Call Pontofrio(dia, mes, ano)

End Sub

Sub Extra(dia As String, mes As String, ano As String)

Dim URL As String
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

URL = "http://www.extra.com.br/listadecasamento/home.aspx"

IE.Navigate URL

Do While IE.Busy
     DoEvents
Loop

Call IE.document.getelementbyid("ctl00_Conteudo_PaginaSistemaArea1_ctl04_txtDia").setattribute("value", dia)
Call IE.document.getelementbyid("ctl00_Conteudo_PaginaSistemaArea1_ctl04_txtMes").setattribute("value", mes)
Call IE.document.getelementbyid("ctl00_Conteudo_PaginaSistemaArea1_ctl04_txtAno").setattribute("value", ano)
IE.document.getelementbyid("ctl00_Conteudo_PaginaSistemaArea1_ctl04_btnEncontrarLista").Click

Do While IE.Busy
     DoEvents
Loop

Sheets("Plan2").Range("A4") = IE.document.getelementsbyclassname("pagination")(0).innertext
Sheets("Plan2").Range("A2").FormulaR1C1 = "=MID(R4C1,R3C1,40)"
Sheets("Plan2").Range("A3").FormulaR1C1 = "=FIND(""pesquisa"",R4C1)"

IE.Quit

Call CopiaeCola(3)

End Sub

Sub Pontofrio(dia As String, mes As String, ano As String)

Dim URL As String
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

URL = "http://www.pontofrio.com.br/Site/ListaGerenciadaCasamentoWelCome.aspx"

IE.Navigate URL

Do While IE.Busy
     DoEvents
Loop

With IE

Call .document.getelementbyid("ctl00_Conteudo_ctl01_CtrlBuscarLista_txtDia").setattribute("value", dia)
Call .document.getelementbyid("ctl00_Conteudo_ctl01_CtrlBuscarLista_txtMes").setattribute("value", mes)
Call .document.getelementbyid("ctl00_Conteudo_ctl01_CtrlBuscarLista_txtAno").setattribute("value", ano)
.document.getelementbyid("ctl00_Conteudo_ctl01_CtrlBuscarLista_btnEncontrarLista").Click

Do While IE.Busy
     DoEvents
Loop

Sheets("Plan2").Range("A4") = IE.document.getelementsbyclassname("pagination")(0).innertext
Sheets("Plan2").Range("A2").FormulaR1C1 = "=MID(R4C1,R3C1,40)"
Sheets("Plan2").Range("A3").FormulaR1C1 = "=FIND(""pesquisa"",R4C1)"

End With

IE.Quit

Call CopiaeCola(4)

End Sub

Answer 1

它是getElementById 而不是getElementsById，尽管您的代码显示了正确的版本。

仅仅因为 IE 不忙并不意味着页面已经完成加载。你需要检查

If IE.ReadyState = READYSTATE_COMPLETE Then '4

您还应该使用Sleep 方法或其他一些方法来防止.Busy 被不断读取。

新增：Win-API 调用可用于Sleep 方法：

Option Explicit

'Declare Sleep API
Private Declare Sub Sleep Lib "kernel32" (ByVal nMilliseconds As Long)

Sub UseIE()
    Dim ie As Object
    Dim thePage As Object
    Dim strTextOfPage As String

    Set ie = CreateObject("InternetExplorer.Application")
    ie.FullScreen = True
    With ie
        .Visible = True
        .Navigate "http://www.bbc.co.uk"
        While Not .ReadyState = READYSTATE_COMPLETE '4
            Sleep 500      'wait 1/2 sec before trying again
        Wend
    End With

    Set thePage = ie.Document