我认为你必须学习 DOM 自动化才能干净地做到这一点。我查看了 ebay 页面上的 HTML，对于以前没有使用过 DOM 自动化的人来说可能有点过头了。我不打算写这篇文章，但听起来你有点紧张，所以你去吧。你可以用它来学习。请记住，这将在短期内起作用，但是当他们更改 HTML 时，它将失败。
Option Explicit
Sub Get_Ebay_Shipping_Charges()
Dim IE As Object, DOM_DOC As Object
Dim URL$, SHIPPING_CHARGES$
Dim SHIPPING_AMOUNT
Dim i&, x&
Dim EL, EL_COLLECTION, CHILD_NODES, TABLE_NODES, TABLE_ROW_NODES, TABLE_DATA_NODES, ITEM_NUMBER_ARRAY
Dim WS As Excel.Worksheet
Dim ITEM_NOT_FOUND As Boolean
''You should change this to the worksheet name you want to use
''ie Set WS = ThisWorkbook.Sheets("Ebay")
Set WS = ThisWorkbook.Sheets(1)
''Create an Internet Explorer Object
Set IE = CreateObject("InternetExplorer.Application")
''Make it visible
IE.Visible = True
''You can replace this with an array that is built from your spreadsheet, this is just for demo purposes
ITEM_NUMBER_ARRAY = Array("290941626676", "130942854921", "400035340501")
''In your code, you can start your loop here to handle the list of items
''This code is a little different for demo purposes
For x = 0 To UBound(ITEM_NUMBER_ARRAY)
''Here is your URL
URL = "http://www.ebay.com/itm/" & ITEM_NUMBER_ARRAY(x) & "?ru=http%3A%2F%2Fwww.ebay.com%2Fsch%2Fi.html%3F_from%3DR40%26_sacat%3D0%26_nkw%3D" & ITEM_NUMBER_ARRAY(x) & "%26_rdc%3D1"
''Navigate to your URL
IE.navigate URL
''This loop will wait until the page is received from the server - the page was hanging for me too so I added a counter to exit after a certain number of loops (this is the i variable)
Do Until IE.readystate = 4 Or i = 50000
i = i + 1
DoEvents
Loop
i = 0
''This sets the DOM document
Set DOM_DOC = IE.document
''First get a collection of table names
Set EL_COLLECTION = DOM_DOC.GetElementsByTagName("table")
If IsEmpty(EL_COLLECTION) Then ITEM_NOT_FOUND = True: GoTo ERR_EXIT
''Then look for the table classname that matches the one we want (in this case "sh-tbl") and set the childnodes to a new collection
For Each EL In EL_COLLECTION
If EL.ClassName = "sh-tbl" Then
Set CHILD_NODES = EL.ChildNodes
Exit For
End If
Next EL
If IsEmpty(CHILD_NODES) Then ITEM_NOT_FOUND = True: GoTo ERR_EXIT
''Next look for the TBODY element in the childnodes collection and set the childnodes of the TBODY element when found
For Each EL In CHILD_NODES
If Not TypeName(EL) = "DispHTMLDOMTextNode" Then
If EL.tagname = "TBODY" Then
Set TABLE_NODES = EL.ChildNodes
Exit For
End If
End If
Next EL
If IsEmpty(TABLE_NODES) Then ITEM_NOT_FOUND = True: GoTo ERR_EXIT
''Find the TR element and set its childnodes to another collection
For Each EL In TABLE_NODES
If Not TypeName(EL) = "DispHTMLDOMTextNode" Then
If EL.tagname = "TR" Then
Set TABLE_ROW_NODES = EL.ChildNodes
Exit For
End If
End If
Next EL
If IsEmpty(TABLE_ROW_NODES) Then ITEM_NOT_FOUND = True: GoTo ERR_EXIT
''Find the first TD element and get it's childnodes
For Each EL In TABLE_ROW_NODES
If Not TypeName(EL) = "DispHTMLDOMTextNode" Then
If EL.tagname = "TD" Then
Set TABLE_DATA_NODES = EL.ChildNodes
Exit For
End If
End If
Next EL
If IsEmpty(TABLE_DATA_NODES) Then ITEM_NOT_FOUND = True: GoTo ERR_EXIT
''The first DIV element holds the shipping information so when it is found, get the innertext of that element
For Each EL In TABLE_DATA_NODES
If Not TypeName(EL) = "DispHTMLDOMTextNode" Then
If EL.tagname = "DIV" Then
SHIPPING_CHARGES = EL.INNERTEXT
Exit For
End If
End If
Next EL
''Make sure a shipping charge was found
If SHIPPING_CHARGES = vbNullString Then MsgBox "No shipping charges found for item " & ITEM_NUMBER_ARRAY(x): GoTo ERR_EXIT
If IsNumeric(Right(SHIPPING_CHARGES, InStr(SHIPPING_CHARGES, Chr(36)))) Then
SHIPPING_AMOUNT = Right(SHIPPING_CHARGES, InStr(SHIPPING_CHARGES, Chr(36)))
Else
SHIPPING_AMOUNT = SHIPPING_CHARGES
End If
''You may have to change this to fit your spreadsheet
WS.Cells(x + 1, 3).Value = SHIPPING_AMOUNT
ERR_EXIT:
If ITEM_NOT_FOUND = True Then MsgBox "No Page Was Found For Item " & ITEM_NUMBER_ARRAY(x): ITEM_NOT_FOUND = False
Next x
IE.Quit
Set IE = Nothing
End Sub
如果您坚持使用现有代码，您还可以尝试在查询后删除查询表。
Dim QRY_TABLE As QueryTable
For Each QRY_TABLE In ThisWorkbook.Sheets(1).QueryTables
QRY_TABLE.Delete
Next
此方法不会删除电子表格上的查询表值，但会终止查询表连接。如果你有太多这些，它可能会导致崩溃。
最后一个建议，如果您的工作簿包含很多内容，vlookups那么这可能是真正的罪魁祸首。祝你好运！
