I'm trying to use Excel VBA to extract the search result names from a table on a webpage (https://lambda.byu.edu/ae/prod/person/cgi/personLookup.cgi).

In the past, I've used code like the following to extract data from a webpage. But I can't seem to figure out how to extract the text from a td tag. The code I’m using gives me a Run-time error ‘424’: Object required.

Any suggestions?

    Sub Macro1()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
Dim Doc As HTMLDocument
IE.navigate "https://lambda.byu.edu/ae/prod/person/cgi/personLookup.cgi"
IE.Visible = True
While IE.Busy Or IE.readyState <> 4
    DoEvents
Wend

Dim i As Integer, iNumberOfLoops As Integer
iNumberOfLoops = Sheets("Extract").Range("D2").Value

For i = 1 To iNumberOfLoops

IE.document.all("inpSearchPattern").Value = ThisWorkbook.Sheets("Extract").Range("A1")

Set objCollection = IE.document.getElementsByTagName("input")

i = 0
    While i < objCollection.Length
       'MsgBox "i= " & i & " Name " & objCollection(I).Name & _
        " Value " & objCollection(I).Value & _
        " Type " & objCollection(I).Type
       If (objCollection(i).Value = "Lookup" And objCollection(i).Type = "button") Then
           Set objElement = objCollection(i)
       End If
        i = i   1
    Wend

    objElement.Click
              
Dim aA As String
aA = Trim(Doc.getElementByTagName("td")(0).innerText)
Sheets("Sheet1").Range("C6").Value = aA

Next i

End Sub

CodePudding user response：

You could do a POST XHR request and pass in searchPattern (last name) and firstName params in the body. Wildcards are supported. Additionally, a Content-Type header is needed with VBA.

You should test that the results table is actually present before attempting to write out. As this is an example to help you I haven't gone to writing out the whole table using a loop (also the table is a mess!). I simply use the clipboard to copy paste with source formatting so table written out is as per website. You can decide how you want to deal with the retrieved table.

If ultimately you are doing multiple lookups then use a loop but create re-usable objects before the loop e.g. xhr and clipboard, and construct the body within the loop.

Option Explicit

Public Sub FindStaff()
    'tools > references > Microsoft HTML Object Library
    Dim html As MSHTML.HTMLDocument, xhr As Object
    
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    Set html = New MSHTML.HTMLDocument
    
    Dim body As String
    
    With xhr
         'here is where you would implement a loop
        .Open "POST", "https://lambda.byu.edu/ae/prod/person/cgi/personLookup.cgi", False
        .setRequestHeader "User-Agent", "Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
         body = "searchPattern=*&firstName=Scott"    'you could construct this from values in cells. searchPattern is Last Name and/or wildcards
        .send body
        html.body.innerHTML = .responseText
    End With   'if looping this would move down to after the End If
    
    Dim table As MSHTML.HTMLTable
    
    Set table = html.querySelector("#Content table")
    
    If table Is Nothing Then
        MsgBox "No results!"
        Exit Sub
    Else
        Dim clipboard As Object
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText table.outerHTML
        clipboard.PutInClipboard
        ActiveSheet.Cells(1, 1).PasteSpecial '<- Alter this to destination. Example alter row for where to write out in a loop.
    End If

End Sub