我需要通过excel 2010 VBA下载ebay运费吗？ [英] I need to download ebay shipping charges through excel 2010 VBA?

问题描述

我一直在努力从ebay下载非免费运送费用。我有这些页面的项目编号。链接应该在ebay上的正确页面。在尝试去页面和下载数据时，Excel挂起并且永远不会恢复。我真的需要这些运费，基本上没有时间。如果这段代码不能固定为不挂起，有人可以告诉我如何获取我需要的信息到Excel？我有其他代码，从ebay的ebay的许多页面获取ebay项目编号，这非常类似于这个，它的效果很好。

I have been trying for days to download non-free shipping charges from ebay. I have the item numbers of the pages. The links should be going to the right pages on ebay. While trying to go to the page and download the data, Excel hangs and never recovers. I REALLY need these shipping charges and am basically out of time. If this code can't be fixed to not hang, can someone please tell me how to get the info I need into Excel? I have other code that gets the ebay item numbers on many pages from ebay that is really similar to this, and it works great.

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

推荐答案

您可以使用xmlHTTP对象，这将轻松下载数据，并且不会使excel卡住。

You can use xmlHTTP object which will download the data easier and wont make the excel stuck.

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）

US $ 2.55

否数据
US $ 6.50

US $2.55
No Data
US $6.50

这篇关于我需要通过excel 2010 VBA下载ebay运费吗？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！