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