VBA Получение информации с сайта

Question

Я пишу код в VBA, чтобы ввести несколько сайтов, поместив дату в поле поиска, а затем получите список номеров os, найденных для этой даты.

Код работает, когда я отлаживаю нажатие клавиши F8, но когда я запускаю макрос, который иногда работает, иногда это не так. Когда я получаю сообщение об ошибке, я просто нажимаю debug, а затем 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 постоянно читать.

Добавлено: Вызов 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