Excel 基于intranet的Web抓取

我编写了一个VBA代码来从我公司的内部网中提取数据

问题：

<td id="myPower_val_9" style="visibility: visible;">
    <input type="text" disabled="disabled" value="300" name="price"></input>
</td>

Sub Button1_Click()

Dim ie As Object
Dim r As Integer
Dim myPoints As String
Dim Doc As HTMLDocument

Set ie = New InternetExplorerMedium

For r = 2 To Range("B65535").End(xlUp).Row

    With ie
        .Visible = 0

        .navigate "www.example.com/product/" & Cells(r, "B").Value

        Do Until .readyState = 4
            DoEvents
        Loop

    End With

    Set Doc = ie.document

    myPoints = Trim(Doc.getElementsByName("price")(0).getAttribute("value"))
    Cells(r, "C").Value = myPoints

Next r

End Sub

出现以下错误：

运行时错误“91”：
对象变量或未设置块变量

它发生在：

myPoints = Trim(Doc.getElementsByName("price")(0).getAttribute("value"))

当我调试它并逐行运行时，它可以检索所有的值

输入和输出：

<td id="myPower_val_9" style="visibility: visible;">
    <input type="text" disabled="disabled" value="300" name="price"></input>
</td>

Sub Button1_Click()

Dim ie As Object
Dim r As Integer
Dim myPoints As String
Dim Doc As HTMLDocument

Set ie = New InternetExplorerMedium

For r = 2 To Range("B65535").End(xlUp).Row

    With ie
        .Visible = 0

        .navigate "www.example.com/product/" & Cells(r, "B").Value

        Do Until .readyState = 4
            DoEvents
        Loop

    End With

    Set Doc = ie.document

    myPoints = Trim(Doc.getElementsByName("price")(0).getAttribute("value"))
    Cells(r, "C").Value = myPoints

Next r

End Sub

我在B列输入多个产品ID，在C列检索数据：
B列=产品ID
C列=价格

HTML:

<td id="myPower_val_9" style="visibility: visible;">
    <input type="text" disabled="disabled" value="300" name="price"></input>
</td>

Sub Button1_Click()

Dim ie As Object
Dim r As Integer
Dim myPoints As String
Dim Doc As HTMLDocument

Set ie = New InternetExplorerMedium

For r = 2 To Range("B65535").End(xlUp).Row

    With ie
        .Visible = 0

        .navigate "www.example.com/product/" & Cells(r, "B").Value

        Do Until .readyState = 4
            DoEvents
        Loop

    End With

    Set Doc = ie.document

    myPoints = Trim(Doc.getElementsByName("price")(0).getAttribute("value"))
    Cells(r, "C").Value = myPoints

Next r

End Sub

---

我是否错过了错误处理程序？

如果您只想忽略错误并继续下一次迭代，请使用以下修改后的代码：

Sub Button1_Click()

Dim ie As Object
Dim r As Integer
Dim myPoints As String
Dim Doc As HTMLDocument


Set ie = New InternetExplorerMedium


For r = 2 To Range("B65535").End(xlUp).Row

With ie
  .Visible = 0

  .navigate "www.example.com/product/" & Cells(r, "B").Value

   Do Until .readyState = 4
   DoEvents
   Loop

End With


 Set Doc = ie.document


 'Edit:
 myPoints = ""

 On Error Resume Next
 myPoints = Trim(Doc.getElementsByName("price")(0).getAttribute("value"))
 On Error Goto 0

 Cells(r, "C").Value = myPoints

Next r

End Sub

---

在访问任何元素之前，您需要等待文档完全呈现并且DOM可用<一旦页面连接并开始加载，code>ie.ReadyState将更改为

ReadyState\u COMPLETE

。调试时代码可以工作的原因是，在开始使用调试器的几秒钟内，页面完成加载

With ie
   .Visible = True
   .Navigate "www.example.com/product/" & Cells(r, "B").Value

   Do Until .ReadyState = READYSTATE_COMPLETE
       DoEvents
   Loop
   Do Until .Document.ReadyState = "complete"
       DoEvents
   Loop
End With

---

我还建议您使ie窗口可见，至少在开发时是这样。完成功能并调试后，可以使窗口不可见。请记住，如果您在代码完成时忘记关闭不可见的IE窗口，您的用户将最终导致失控的iexplore.exe进程。

您也可以循环，直到元素设置完毕（同时添加超时子句）

---

您调试了整个循环还是只调试了一次迭代？对于单个迭代，网页可能不包含所需的元素。尝试设置ie.visible=true，并在出现错误时分析网页。@silentsurfer我循环了整个代码，它只发生在那一行。我在我家的美国雅虎财经（互联网）上尝试了类似的代码，效果很好。我可以添加任何错误处理程序来修复代码吗？我不相信这是答案。询问者的代码已经包含一个循环，等待ie.readyState变为等于4。（互联网控制库中READYSTATE_COMPLETE等于4）我想你误解了我的答案？也许我说得不够仔细，但你需要检查ie.ReadyState和ie.Document.ReadyState。ie.ReadyState在文档完全加载之前变为ReadyState\u COMPLETE。只有当ie.Document.ReadyState==“complete”时，DOM才会完全加载。