如何循环遍历多个网站的 "getElementById" VBA？

Question

我是一个非营利组织的成员，该组织寄信鼓励数百名狱中囚犯。他们经常被意外转移，来不及通知地址变更。但是，每个人在被监禁期间的位置是保持最新状态并可在州政府的网站上公开访问。

我正在尝试编写 VBA，它通过我的 "contact" 列表并访问每个州政府的囚犯位置网站（基于每个囚犯的 ID），然后从网站中提取每个人的位置，为此将其放在与该特定人员姓名和 ID 的行相对应的列（$C）中。这样我就可以运行自动检查以确认每个人仍在同一位置，然后再执行 Excel 邮件合并以打印带有地址的信封标签。

每个人的网站都是一样的，只是在最后改变了他们的囚犯 ID（例如，http://mdocweb.state.mi.us/OTIS2/otis2profile.aspx?mdocNumber=226475）
我只需要确认惩教设施——所以我只需要从每个囚犯各自的页面中提取一项。我已经能够为一个人成功提取它，但是在使用正确的循环序列来获取下一个并将其输出到同一行时遇到了问题。

这是我用来获取正确值的方法（我刚刚使用 MsgBox CFTitle 进行了测试）

Dim IE As New InternetExplorer
IE.Visible = False
IE.navigate "http://mdocweb.state.mi.us/OTIS2/otis2profile.aspx?mdocNumber=" & Range("PrisonerID").Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Dim CFTitle As String
CFTitle = Trim(Doc.getElementById("valLocation").innerText)

这里是姓名列表示例（带有实际囚犯 ID）的屏幕截图，使用与我的列表相同的列： Example of Excel Contact Sheet

Answer 1

这是一个快速的方法。

我从 sheet（K 列）中将囚犯 ID 读入数组。如果你从 sheet 读入，你会得到一个二维数组，然后循环第一个维度来获取 id。

我循环那个数组，为每个 id 发出一个无浏览器的 XHR 请求。这是通过 GET 请求检索您的信息的快速方法。

我使用.getElementById("valLocation")获取惩教设施信息。

我将这些结果存储在一个名为 facilities 的数组中。

最后，我将 ID 和位置写到 sheet，列 C，其中：

.Cells(2, 3).Resize(UBound(facilities) + 1, 1) = Application.WorksheetFunction.Transpose(facilities)

VBA:

Option Explicit
Public Sub GetInfo()
    Dim sResponse As String, ids(), facilities(), i As Long, ws As Worksheet, counter As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")   '<==change as appropriate
    ids = ws.Range("K2:K" & GetLastRow(ws)).Value
    ReDim facilities(UBound(ids, 1) - 1)
    Application.ScreenUpdating = False
    On Error GoTo errhand
    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(ids, 1) To UBound(ids, 1)
            counter = counter + 1
            .Open "GET", "http://mdocweb.state.mi.us/OTIS2/otis2profile.aspx?mdocNumber=" & ids(i, 1), False
            .send
            sResponse = StrConv(.responseBody, vbUnicode)
            sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

            With CreateObject("htmlFile")
                .Write sResponse
                facilities(i - 1) = .getElementById("valLocation").innerText
            End With
NextId:
        Next i
    End With
    With ws
        .Cells(2, 3).Resize(UBound(facilities) + 1, 1) = Application.WorksheetFunction.Transpose(facilities)
    End With
    Application.ScreenUpdating = True
    Exit Sub

errhand:
    Debug.Print counter
    Debug.Print Err.Number & " " & Err.Description
    Select Case Err.Number
        Case 91
        Err.Clear
        facilities(i - 1) = "Not found"
        GoTo NextId
    End Select
    Application.ScreenUpdating = True
End Sub

sheet结果：

如何循环遍历多个网站的 "getElementById" VBA？

How can I loop through my "getElementById" VBA for multiple websites?

excel

vba

extract

web-scraping