Question

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

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

的行中

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

错误消息是：运行时错误＆＃39; 424＆＃39;，该对象是必需的。

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

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

VBA从网站获取信息

1 个答案: