VBA从网站获取信息

Question

我正在VBA中编写代码，在几个网站中输入在搜索字段中输入日期，然后获取该日期找到的号码列表。

该代码工程，当我debuggind按F8键，但是当我运行宏它有时工作有时不会。当我收到错误消息时，我只需按下调试按钮，然后按F5继续执行宏，并按照它的原理工作。问题总是occours与行：

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被不断地阅读。

新增：一种双赢的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