我需要通过Excel 2010 VBA下载易趣运费？
我一直在尝试几天，从ebay下载非免费送货费用。 我有页面的项目编号。 链接应该在ebay上正确的页面。 在尝试访问该页面并下载数据时，Excel挂起并且不能恢复。 我真的需要这些运费，基本上是时间。 如果这个代码不能修复，不能挂起，有人可以告诉我如何获得我需要的信息到Excel？ 我有其他的代码，从ebay很多页面上得到的ebay项目号码是非常相似的，它很好。
itemNumberAlone = Range("a" & eachItem).Value With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.ebay.com/itm/" & itemNumberAlone & "?ru=http%3A%2F%2Fwww.ebay.com%2Fsch%2Fi.html%3F_from%3DR40%26_sacat%3D0%26_nkw%3D" & itemNumberAlone & "%26_rdc%3D1" _ , Destination:=Range("$bZ$1")) .Name = "second ebay links" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Do While Not IsError(Application.Match("Shipping and handling", Range("bz1:bz1000"), 0)) If IsError(Application.Match("Shipping and handling", Range("bz1:bz1000"), 0)) Then Exit Do If Not IsError(Application.Match("Shipping and handling", Range("bz1:bz1000"), 0)) Then shippingRow = Application.Match("Shipping and handling", Range("bz1:bz1000"), 0) + 1 shippingCell = Range("bz" & shippingRow).Value If Left(shippingCell, 2) <> "US" Then Range("bz" & shippingRow - 1).ClearContents Else Range("c" & eachItem).Value = Right(shippingCell, Len(shippingCell) - 2) End If End If Loop End If Next 我想你将不得不学习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
此方法不会删除电子表格上的查询表值，但会终止查询表连接。 如果你有太多的这些，可能会造成崩溃。
最后一个build议是，如果你的工作簿包含很多vlookups那么这可能是真正的罪魁祸首。 祝你好运！
您可以使用xmlHTTP对象，这将更容易地下载数据，并不会使Excel卡住。
Sub xmlHttp() Dim xmlHttp As Object Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0") Dim ITEM_NUMBER_ARRAY As Variant ITEM_NUMBER_ARRAY = Array("290941626676", "130942854921", "400035340501") 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" xmlHttp.Open "GET", URL, False xmlHttp.setRequestHeader "Content-Type", "text/xml" xmlHttp.send Dim html As Object Set html = CreateObject("htmlfile") html.body.innerHTML = xmlHttp.ResponseText Set objShipping = html.getelementbyid("shippingSection").getElementsbytagname("td")(0) If Not objShipping Is Nothing Then Set divShip = objShipping.ChildNodes(1) Debug.Print divShip.innerHTML Else Debug.Print "No Data" End If Next End Sub
即时窗口（Ctrl + G）
2.55美元
没有数据
6.50美元
