我正在嘗試使用 Excel VBA 從網頁 ( https://lambda.byu.edu/ae/prod/person/cgi/personLookup.cgi )上的表格中提取搜索結果名稱。
過去，我使用如下代碼從網頁中提取資料。但我似乎無法弄清楚如何從 td 標簽中提取文本。我正在使用的代碼給了我一個運行時錯誤“424”：需要物件。
有什么建議？
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
uj5u.com熱心網友回復：
您可以執行 POST XHR 請求并在正文中傳入 searchPattern（姓氏）和 firstName 引數。支持通配符。此外，VBA 需要一個 Content-Type 標頭。
在嘗試寫出之前，您應該測驗結果表是否實際存在。由于這是一個可以幫助您的示例，因此我沒有去使用回圈寫出整個表格（表格也一團糟！）。我只是使用剪貼板復制粘貼源格式，所以表寫出來是根據網站。您可以決定如何處理檢索到的表。
如果最終您要進行多次查找，則使用回圈但在回圈之前創建可重用的物件，例如xhrand clipboard，并body在回圈內構造。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/342820.html
上一篇：VBA：根據條件選擇隨機單元格