Question

我是一个非营利组织的一部分，该组织发送信件来鼓励数百人入狱。它们经常被意外转移，没有时间通知地址更改。但是，每个人在被监禁的情况下都会保持最新状态，并且可以在州政府的网站上公开访问。

我正在尝试编写VBA，该VBA将遍历我的“联系人”列表并访问每个州政府的囚犯所在地网站（基于每个囚犯的ID），然后从网站中提取每个人的位置，并将其放置在列中（$ C ），与该特定人员的姓名和ID的行相对应。这样，我可以自动运行检查以确认每个人仍在同一位置，然后再执行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

这是一种快速的方法。

我从工作表（第K列）中将囚犯ID读入数组。如果您从工作表中读取，则会得到一个2D数组，然后循环执行第一个维度以获取ID。

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

我使用.getElementById("valLocation")来获得教养所信息。

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

最后，我用以下代码将ID和位置写到工作表的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

工作表中的结果

如何在多个网站中遍历“ getElementById” VBA？

1 个答案: