Pull specific text from a website and paste it into a specific cell

[Atenza30]

I have been trying to pull specific text from a website, but I am getting stuck actually getting it to return any values. Here is my code. Please help!

 

[Atenza30]

I have been trying to pull specific text from a website, but I am getting stuck actually getting it to return any values. Here is my code. Please help!

Option Explicit
Const sSiteName = "https://www.absecom.psu.edu/ELIVING/STAFF_PAGES/CHECK_IN_DEPARTURE_WIN.cfm"

Private Sub Pending()

Dim oIE As Object
Dim oHDoc As HTMLDocument
Dim hTable As Object, clipboard As Object, t As Date
Dim Var As String


Set oIE = CreateObject("InternetExplorer.Application")

' Open Internet Explorer Browser and keep it visible.
With oIE
.Visible = True
.navigate sSiteName
End With

While oIE.readyState <> 4
DoEvents
Wend

Set oHDoc = oIE.document

With oHDoc
.getElementById("sel_SEMESTER").Value = "321"
.getElementById("txt_EFFECTIVE_DATE").Value = "05/08/2022"
.getElementById("sel_COMMONS_DESK").Value = "2"
.getElementById("sel_BUILDING").Value = "0"
oIE.document.getElementsByName("rad_RECORD_SELECT")(2).Checked = True
.getElementById("but_PRINT_LOCAL").Click

End With

While oIE.Busy Or oIE.readyState <> 4: DoEvents: Wend

Do
On Error Resume Next
Set hTable = oIE.document.querySelector("#reportList > table:nth-child(1) > tbody > tr:nth-child(2) > td:nth-child(2)")

Loop While hTable Is Nothing
If Not hTable Is Nothing Then
clipboard.SetText hTable.Text
clipboard.PutInClipboard
ThisWorkbook.worksheets(Sheet1).Range("A2").PasteSpecial
Set hTable = Nothing
End If

oIE.document.parentWindow.execScript "Javascript: document.frm_CHECK_OUT.action='../STAFF_REPORTS/CHECK_IN_DEPARTURE_TO_EXCEL_WIN.cfm'; document.frm_CHECK_OUT.submit()", "JavaScript"


End Sub