Excel VBA to Open Office code
Posted: Mon Aug 14, 2017 1:30 pm
Hello,
I fail to convert this excel macro to open office and would be happy if somebody can help me. This macro checks automatically the prices from ebay products.
Can somebody tell me, if it is possible in Open Office, to excess web pages and extract info's?
I fail to convert this excel macro to open office and would be happy if somebody can help me. This macro checks automatically the prices from ebay products.
Can somebody tell me, if it is possible in Open Office, to excess web pages and extract info's?
Code: Select all
Sub Get_eBay_Product()
'Macro to extract Product Details from eBay shopping website for single product
'Author : Raghu Ram Alla
'Date : March 19, 2015
'Website : http://www.QuadExcel.com
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
iRow = 5: iCol = 1
URL = Wks_eBay_Prod.Range("ProdURL").Value
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
'Item Condition
Set objShipping = html.getElementById("vi-itm-cond")
If Not objShipping Is Nothing Then
Wks_eBay_Prod.Cells(iRow, iCol).Value = objShipping.innerText
End If
iCol = iCol + 1
'Product Name
Set objShipping = html.getElementById("vi-lkhdr-itmTitl")
If Not objShipping Is Nothing Then
Wks_eBay_Prod.Cells(iRow, iCol).Value = objShipping.innerText
End If
iCol = iCol + 1
'Price
Set objShipping = html.getElementById("prcIsum")
If Not objShipping Is Nothing Then
Wks_eBay_Prod.Cells(iRow, iCol).Value = objShipping.innerText
End If
iCol = iCol + 1
'Shipping
Set objShipping = html.getElementById("shippingSection").getElementsByTagName("td")(0)
If Not objShipping Is Nothing Then
Set divShip = objShipping.ChildNodes(1)
Wks_eBay_Prod.Cells(iRow, iCol).Value = divShip.innerHTML
End If
End Sub