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

问题

I'm part of a non-profit that sends letters to encourage hundreds of people in prison. They are often transferred unexpectedly, with no time to give notice of address change. However, each person's location while incarcerated is kept up-to-date and publicly accessible on the state government's website.

I am trying to write VBA that goes through my "contact" list and visits each state government's prisoner location website (based on each prisoner's ID), then extracts each person's location from the website, places that in a column ($C) for that purpose which corresponds to the row for that specific person's name & ID. That way I could run a check automatically to confirm each one is still at the same location before I do an Excel mailmerge to print envelope labels with their addresses.

The website is the same for each one, changed only by their prisoner ID at the end (e.g., http://mdocweb.state.mi.us/OTIS2/otis2profile.aspx?mdocNumber=226475)
All I need is to confirm the correctional facility — so I need to extract just one item from each prisoner's respective page. I've been able to successfully extract it for one person, but am having trouble using a proper loop sequence to get the next one, and output it into the same row.

Here's what I'm using to get the correct value (I've just been testing with a 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)

And here is a screenshot of an example list of names (with actual Prisoner IDs), using the same columns as my list: Example of Excel Contact Sheet

回答1:

This is a quick way.

I read the prisoner ids into an array from a sheet (column K). If you read in from a sheet you get a 2D array and then loop the first dimension to get the ids.

I loop that array issuing a browserless XHR request for each id. This is a quick way to retrieve your information via GET request.

I use .getElementById("valLocation") to get the correctional facility information.

I store these results in an array called facilities.

At the end I write the ids and locations out to the sheet, column C, with:

.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

Result in the sheet:

来源：https://stackoverflow.com/questions/51118422/how-can-i-loop-through-my-getelementbyid-vba-for-multiple-websites

标签

excel

vba

excel-vba

web-scraping

extract