• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Price and name extraction from site

aqeelll

New Member
can anyone build VBA code for name and price extraction from URLs in column A into column B and C respectively.

best regards
 

Attachments

  • price and name.xlsx
    8.5 KB · Views: 9
Needs reference to Microsoft HTML Object Library:
Code:
Public Function GetPrice(url As String)
Dim x(1 To 1, 1 To 2)
Dim XMLHTTP As Object, html As HTMLDocument
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.ResponseText
x(1, 1) = html.getElementsByClassName("product_title entry-title")(0).innerText
Set bb = html.getElementsByClassName("woocommerce-price  organique-woo-price")(0).getElementsByTagName("meta")
'x(1, 2) = bb(1).Content & " " & bb(0).Content 'include currency designation as an alternative to line below.
x(1, 2) = CDbl(bb(0).Content)
GetPrice = x
End Function
Formula example, in 2 cells B2:C2 array-enter (Ctrl+Shift+Enter, not just Enter) this:
=GetPrice(A2)

See attached.
 

Attachments

  • chandoo32860price and name.xlsm
    15.8 KB · Views: 8
Added another URL to extract price and name but showing #VALUE! error. Is it possible to add play or any button to initiate script?

See attached.
 

Attachments

  • chandoo32860price and name.xlsm
    15.7 KB · Views: 7
As soon as I opened your sample sheet the values appeared (although it showed on the last row that you array-entered only one cell at a time).
Were you connected to the internet at the time? Does where you are block access to some sites?

You could write a macro like:
Code:
Sub blah()
For Each cll In Selection.Cells
  cll.Offset(, 1).Resize(, 2).Value = GetPrice(cll.Value)
Next cll
End Sub
which will put the names and prices to the right of the currently selected cells (which should contain the urls).
 
Last edited:
What I do is just add new url on cell A5 and, in cell B5 entered =GetPrice(A5) and press CTRL+SHIFT+ENTER but showing #VALUE! error, what wrong I am doing?
 
(although it showed on the last row that you array-entered only one cell at a time). what do u mean by that ?
 
When I open your file note that the last row, the Bio Apricot Kernels is showing twice:
upload_2017-2-22_23-40-8.png
because you should have selected both cells at once and CTRL+Shift+Enter.
 
Code:
Sub blah()
For Each cll In Selection.Cells
  cll.Offset(, 1).Resize(, 2).Value = GetPrice(cll.Value)
Next cll
End Sub

Through this macro I can update name and price. right?
 
Code:
Sub blah()
For Each cll In Selection.Cells
  cll.Offset(, 1).Resize(, 2).Value = GetPrice(cll.Value)
Next cll
End Sub

Through this macro I can update name and price. right?
Yes, as I said: "which will put the names and prices to the right of the currently selected cells (which should contain the urls)."
 
yeah website is accessible through browser. Can you give me the screenshot of adding formula for new URL in A7?
 
Detective work required.
1. In the same Reference dialogue box you showed above, do you have any entry such as:
Microsoft XML v.n.0
?

2. Functions don't cause an error to show up when called from a sheet, so put the following macro in the same code-module as the other code and try running it and tell me what happens (details required):
Code:
Sub blah2()
Dim x(1 To 1, 1 To 2)
url = "https://demo.proteusthemes.com/organique/product/bio-crispy-flakes/"
Dim XMLHTTP As Object, html As HTMLDocument
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.ResponseText
x(1, 1) = html.getElementsByClassName("product_title entry-title")(0).innerText
Set bb = html.getElementsByClassName("woocommerce-price  organique-woo-price")(0).getElementsByTagName("meta")
'x(1, 2) = bb(1).Content & " " & bb(0).Content
x(1, 2) = CDbl(bb(0).Content)

MsgBox x(1, 1)
MsgBox x(1, 2)
MsgBox bb(1).Content

End Sub
(It should come up with 3 message boxes containing Bio Crispy Falkes, 9 and USD.

Depending on your answers I may try to re-write the code without using MSXML.
 
Added XML reference 6.0
I didn't ask you to add it - it shouldn't be necessary. I just wanted to know whether there was an entry for it, which would indicate to me whether MSXML was on your machine.

You no longer need blah2; delete it.

Now, I don't know what you mean regarding 'update manually . Latest values can be gained by just recalculating the sheet.
If you're talking about using blah, just select the cells with the urls in and run blah again.
 
By the way, I see you're putting code in the Sheet1 code-module; any code there will disappear when you delete the sheet. It should be in a standard code-module such as Module1. (Although I see from your last picture you might have moved to Module2!)
 
Back
Top