网页在 VBA 中抓取表格答案

【问题标题】：Web scraping a table in VBA网页在 VBA 中抓取表格
【发布时间】：2020-04-24 10:42:36
【问题描述】：

我已成功导航到包含我希望从中提取数据的表的页面。让我从一开始就坦率地说，这是我第一次尝试这样的事情，我真的很高兴自己能走到这一步。我导航到我想要的网页，更新了用户名、密码，然后导航到包含我感兴趣的表格的页面。

我现在正在尝试从表中提取数据，但出现以下错误，请参见下文：

我的代码如下：

'==============================================================
'
Public IE                   As New SHDocVw.InternetExplorer
'==============================================================
'                           HTML DOCUMENT
'
Public HTMLDoc              As MSHTML.HTMLDocument
'==============================================================
'                           BUTTON COLLECTION
'
Public HTMLButtons          As MSHTML.IHTMLElementCollection
Public HTMLButton           As MSHTML.IHTMLElement
'==============================================================
'                           ATTRIBUTE COLLECTION
'
Public HTMLAs               As MSHTML.IHTMLElementCollection3
Public HTMLA                As MSHTML.IHTMLElement3
'==============================================================
'                           TABLE COLLECTION
'
Public HTMLTables           As MSHTML.IHTMLElementCollection
Public HTMLTable            As MSHTML.IHTMLElement
'==============================================================
'                           TABLE ELEMENTS
'
Public TableBody            As MSHTML.IHTMLElementCollection2
Public TableRows            As MSHTML.IHTMLElementCollection3
Public TableCell            As MSHTML.IHTMLElementCollection4
'==============================================================
Public RowNum               As Long
Public ColNum               As Long
'==============================================================
'
'
Public Sub TableCollection()

Worksheets.Add
RowNum = 1
Set TableBody = HTMLDoc.getElementsByTagName("tbody")
Set TableRows = HTMLDoc.getElementsByTagName("tr")
Set TableCell = HTMLDoc.getElementsByTagName("td")
For Each TableRows In TableBody
    ColNum = 1
    For Each TableCell In TableRows
        Cells(RowNum, ColNum).Value = TableCell.innerText
        ColNum = ColNum + 1
    Next TableCell
RowNum = RowNum + 1
Next TableRows
End Sub

"============================================== ========================

下面是我要抓取的表格的标题和元素之一。我已将 URL 替换为 WEBADDRESS

<html><head>
  <title>
    Transaction SpreadSheet for the Current Month to date - April 2020</title>
</head>
<body>
<style>
  td { font-family:arial,verdana,sans-serif;font-size:12px;color:#000000;line-height:16px;}
</style>
<table cellpadding="2">
  <tbody>
  <tr>
    <td>
      <b>Date</b>
    </td>
    <td>
      <b>Reference</b>
    </td>
        <td>
      <b>Item</b>
    </td>
    <td>
      <b>Particulars</b>
    </td>
    <td>
      <b>Buyer</b>
    </td>
        <td>
      <b>Order Id</b>
    </td>
    <td>
      <b>Note</b>
    </td>
    <td>
      <b>Transaction Amount</b>
    </td>
   </tr>
<tr>
  <td>
    04&nbsp;Apr&nbsp;2020</td>
    <td>
    239137532</td>  
  <td>
    <a href="https://WEBADDRESS">461619577</a></td>
  <td>
    Success Fee</td>
  <td>
  <a title="User profile for Joe" href="WEBADDRESS">RoySch2510</a>
  </td>
    <td>
  <a href="https://WEBADDRESS" rel="nofollow,noindex">17314294</a>
  </td>
  <td>
    </td>   
  <td>
    -62.55</td>
  </tr>
<tr>

请指教我做错了什么

好的，这是我所有的代码，我希望它能提供更多的见解：

Option Explicit

Public Sub GetHTMLDocument()
'===========================================================================
'                         ESTABLISH PUBLIC VARIABLES
'
Call PublicHTMLVariables
'===========================================================================
'                              NAVIGATE TO IE
'
Call NavigateToIE("https://old.bidorbuy.co.za/jsp/login/UserLogin.jsp")
'===========================================================================
'                                   LOGIN
'
Call LoginToWebsite("JoeCam9517", "********")
'===========================================================================
'                           NAVIGATE TO 1st PAGE
'
Call NavigateToFirstPage
'===========================================================================
'                      NAVIGATE TO ACCOUNT HISTORY PAGE
'
Call NavigateToAccountsPage
'===========================================================================
'               CHANGE THE DATE RANGE FOR TRANSACTION SELECTION
'
'Call ChangeDateRange
'===========================================================================
'                      NAVIGATE TO ACCOUNT TABLE PAGE
'
Call NavigateToTablesPage
'===========================================================================
'                     COLLECT TABLE ELEMENTS TO WORKSHEET
'
Call TableCollection
'===========================================================================

MsgBox "Pause"
'                       MORE CODE STILL TO BE DEVELOPED

End Sub

公共变量

Option Explicit
'==============================================================
'
Public IE                   As New SHDocVw.InternetExplorer
'==============================================================
'                           HTML DOCUMENT
'
Public HTMLDoc              As MSHTML.HTMLDocument
'==============================================================
'                           HTML ELEMENTS
'
Public HTMLInput            As MSHTML.IHTMLElement
Public FromDay              As MSHTML.IHTMLElement
Public FromYearMonth        As MSHTML.IHTMLElement
Public ToDay                As MSHTML.IHTMLElement
'==============================================================
'                           BUTTON COLLECTION
'
Public HTMLButtons          As MSHTML.IHTMLElementCollection
Public HTMLButton           As MSHTML.IHTMLElement
'==============================================================
'                           ATTRIBUTE COLLECTION
'
Public HTMLAs               As MSHTML.IHTMLElementCollection3
Public HTMLA                As MSHTML.IHTMLElement3
'==============================================================
'                           TABLE COLLECTION
'
Public HTMLTable            As MSHTML.IHTMLElement
Public HTMLTableRows        As MSHTML.IHTMLElementCollection
Public HTMLTableCells       As MSHTML.IHTMLElementCollection
'==============================================================
'                           DATE ELEMENTS
'
Public ToYearMonth          As MSHTML.IHTMLElement
'==============================================================
'                           TABLE ELEMENTS
'
'Public TableBody            As MSHTML.IHTMLElementCollection2
'Public TableRows            As MSHTML.IHTMLElementCollection3
'Public TableCell            As MSHTML.IHTMLElementCollection4
'==============================================================
Public H                    As Integer
Public RowNum               As Long
Public ColNum               As Long
'==============================================================

Public Sub PublicHTMLVariables()

End Sub

导航到网页

Option Explicit

Public Sub NavigateToIE(Destination As String)
IE.Visible = True
IE.Navigate Destination
Do Until IE.ReadyState = 4
    DoEvents
Loop
End Sub

准备登录

Option Explicit
Public Sub LoginToWebsite(UserID As String, PassWord As String)
Set HTMLDoc = IE.Document
Set HTMLInput = HTMLDoc.getElementById("username")
    HTMLInput.Value = UserID
Set HTMLInput = HTMLDoc.getElementById("password")
    HTMLInput.Value = PassWord
End Sub

导航到第一页

Option Explicit
'===========================================================================
'
'
Public Sub NavigateToFirstPage()
Set HTMLButtons = HTMLdoc.getElementsByTagName("button")
HTMLButtons(3).Click
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
End Sub

导航到帐户历史记录页面

Option Explicit

'===========================================================================
'                      NAVIGATE TO ACCOUNT HISTORY PAGE
'
Public Sub NavigateToAccountsPage()
H = 0
Set HTMLAs = HTMLdoc.getElementsByTagName("a")
For Each HTMLA In HTMLAs
    If HTMLA.href = "https://old.bidorbuy.co.za/jsp/fee/UserAccount.jsp" Then
        GoTo ButtonFound
    End If
    H = H + 1
Next HTMLA
ButtonFound:
HTMLAs(H).Click
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
End Sub

更改日期范围 - 不起作用 - 我将在以后寻求帮助

导航到表格页面

Option Explicit
 

'=========================================================================
'
'                      NAVIGATE TO ACCOUNT TABLE PAGE
'
Public Sub NavigateToTablesPage()
Set HTMLButtons = HTMLdoc.getElementsByName("DetailSubmit")
HTMLButtons(1).Click
End Sub

这将我们带到我遇到问题的程序

Option Explicit
'===========================================================================
'
'
Public Sub TableCollection()
Worksheets.Add

Dim HTMLdoc         As New HTMLDocument
Dim trow            As Object
Dim tcel            As Object
Dim rowNum          As Long
Dim colNum          As Long

rowNum = 1

For Each trow In HTMLdoc.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
    colNum = 1
    For Each tcel In trow.getElementsByTagName("td")
        Cells(rowNum, colNum).Value = tcel.innerText
        colNum = colNum + 1
    Next tcel
    rowNum = rowNum + 1
Next trow
End Sub

'Set HTMLTable = HTMLDoc.getElementsByTagName("body")
'Set HTMLTableRows = HTMLdoc.getElementsByTagName("tr")
'Set HTMLTableCells = HTMLdoc.getElementsByTagName("td")
'For Each HTMLTableCells In HTMLTableRows
'Debug.Print HTMLTableRows.innerText
'Next HTMLTableCells
'    ColNum = 1
'    For Each TableCell In TableRows
'        Cells(RowNum, ColNum).Value = TableCell.innerText
'        ColNum = ColNum + 1
'    Next TableCell
'RowNum = RowNum + 1
'Next TableRows

我知道要查看很多其他人的代码，但我确实尝试编写代码时考虑到其他人可能需要对其进行编辑。另外，我很抱歉我没有遵循正常的约定，但是当我看到一个以小写字母开头的变量然后在中途你得到一个大写字母时，它让我感到很恼火，它看起来并不优雅，抱歉:-)

我开始怀疑问题出在表格的构造方式上，这可能吗？

我想对所有试图解决我的问题的人说声谢谢，但我仍然坚持同样的结果。使用上面的代码，我得到了这个表：然后我得到这个错误。

正如您从注释掉的代码中看到的那样，我尝试了几种不同的编码选项，但我总是收到错误。

【问题讨论】：

你能展示更多你的代码吗（页面加载和等待）？ TableCell 设置为文档中所有 td 的集合，是一个集合。相反，您希望在给定行的循环中循环 Table（设置为 Object）；一个表有表行；表格行有表格单元格。您要确保循环特定表格的行和表格单元格（不是 HTMLDocument 中的所有行和所有 tds）。

标签： vba web-scraping

【解决方案1】：

我编写了一些函数来读取任何 HTML 表格。尝试使用它。 HTMLTab 作为函数的参数当然必须是 HTMLTable / IHTMLTable 对象。 :)

Function ReadTable(HTMLTab) As Variant
Dim myTable() As Variant

  rLen = HTMLTab.Rows.Length
  CLen = HTMLTab.Cells.Length / rLen
  ReDim myTable(0 To rLen - 1, 0 To CLen - 1)

  For Each myRow In HTMLTab.Rows
    j = 0
    For Each myCell In myRow.Cells
      myTable(i, j) = myCell.outerText
      j = j + 1
    Next myCell
    i = i + 1
  Next myRow

  ReadTable = myTable

End Function

【讨论】：

感谢您的建议，但我真正想要的是找出我的代码无法正常工作的原因。我显然做错了什么，但我看不到。当有人指出我的错误时，我可能会踢自己。如果我不能让我的代码工作，那么我一定会尝试你的优秀代码。谢谢你，乔