Get two bits of Data from Microsoft Web Browser Control Access 2007 (1 Viewer)

jeffreylewis

New member
Local time
Today, 12:03
Joined
Sep 17, 2020
Messages
7
In Ms Access 2007 32 Bit
Windows 10

I am trying to extract data from a website that updates 2 fields on a regular basis.

I have created a form which has a large Microsoft Web Browser Control called "WebBrowser0"
and a field with the url called "URL
I am able to get the Microsoft Web Browser Control to load and display the website correctly.

The Form also has 2 other fields called.
"quantity"
"showPrice"

I would like to extract data from the website showing in the Microsoft Web Browser Control
And put it into the 2 fields "quantity" and "showPrice"

The source on the webpage is:
<div class="quantity">Qty <input name="Quantity" type="text" value="1" maxlength="3" /></div>
<strong class="showPrice" style="">THE PRICE APPEARS HERE</strong>

Can anyone help?
Getting desparate
 

Isaac

Lifelong Learner
Local time
Today, 04:03
Joined
Mar 14, 2017
Messages
2,701
This may take a bit of patience and study, but here are two excellent discussions that will help.

This
and This

on this one I uploaded a sample attachment which may be of interest
 

arnelgp

error reading drive A:
Local time
Today, 20:03
Joined
May 7, 2009
Messages
10,855
sample scraping:
Code:
    Dim ipos As Integer
    Dim dblQuantity As Double
    Dim dblPrice As Double
    Dim strQuantity As String
    Dim html As String

    html = html & "<html><head>"
    html = "<html>" & _
        "<head></head>" & _
        "<body>" & _
        "<div class=""quantity"">Qty <input name=""Quantity"" type=""text"" value=""1"" maxlength=""3"" /></div>" & _
        "<strong class=""showPrice"" style="""">100.00</strong>" & _
        "</body>" & _
        "</html>"

    'check first if the textbox is present
    ipos = InStr(html, "<input name=""Quantity""")
    If ipos > 0 Then
        'textbox is present
        'get the Value for Quantity
        ipos = InStr(ipos, html, "value=")
        html = Mid(html, ipos + Len("value="))
        ipos = InStr(1, html, "maxlength")
        'this is the quantity
        strQuantity = Trim(Left(html, ipos - 1))
        Do While InStr(1, strQuantity, """") > 0
            strQuantity = Replace(strQuantity, """", "")
        Loop
        dblQuantity = CDbl(strQuantity)
    End If
    'check if class showPrice is present
    ipos = InStr(1, html, "<strong class=""showPrice""")
    If ipos > 0 Then
        'showPrice is present
        ipos = InStr(ipos, html, ">")
        html = Mid(html, ipos + 1)
        ipos = InStr(1, html, "<")
        dblPrice = CDbl(Left(html, ipos - 1))
    End If
    objIE.Quit
    Debug.Print dblQuantity
    Debug.Print dblPrice
 

jeffreylewis

New member
Local time
Today, 12:03
Joined
Sep 17, 2020
Messages
7
Hi Arnelgp

Your code is the closest I have got to achieving my aim for these 2 fields.
I would like to have shared my answer on this site after 1.5 hours composing a response the administrators say that the response contains spam like elements and will not allow me to post.

So I have attached a text file which is my answer to you

Best regards
and Thanks


Snap4.jpg
 

Attachments

  • Arnelgp.txt
    2.4 KB · Views: 21

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
7,117
Crossposted with responses.
 

jeffreylewis

New member
Local time
Today, 12:03
Joined
Sep 17, 2020
Messages
7
Hi Gasman

It still tells me

Although the preview displays correctly.
I have 3 urls to show as examples outside of the code area

Your content can not be submitted. This is likely because your content is spam-like or contains inappropriate elements. Please change your content or try again later. If you still have problems, please contact an administrator.
 

arnelgp

error reading drive A:
Local time
Today, 20:03
Joined
May 7, 2009
Messages
10,855
see if this modified code will work for you:
Code:
Private Sub Command1_Click()
    Dim ipos As Long
    Dim dblQuantity As Double
    Dim dblPrice As Double
    Dim strQuantity As String
    Dim strCurrency As String
    Dim strPrice As String
    Dim HTML As String

    HTML = Me.WebBrowser0.Object.Document.documentElement.OuterHtml

    'check if class showPrice is present
    ipos = InStr(1, HTML, "<strong class=""showPrice""")
    If ipos > 0 Then
        'showPrice is present
        ipos = InStr(ipos, HTML, ">")
        HTML = Mid(HTML, ipos + 1)
        ipos = InStr(1, HTML, "<")
        strPrice = Trim(Left(HTML, ipos - 1))
        strCurrency = getCurrency(strPrice)
        dblPrice = CDbl(Replace(strPrice, strCurrency, ""))
    End If
    
    'check first if the textbox is present
    ipos = InStr(HTML, "<input name=""Quantity""")
    If ipos > 0 Then
        'textbox is present
        'get the Value for Quantity
        ipos = InStr(ipos, HTML, "value=")
        HTML = Mid(HTML, ipos + Len("value="))
        ipos = InStr(1, HTML, "></div>")
        'this is the quantity
        strQuantity = Trim(Left(HTML, ipos - 1))
        Do While InStr(1, strQuantity, """") > 0
            strQuantity = Replace(strQuantity, """", "")
        Loop
        dblQuantity = CDbl(strQuantity)
    End If
    Debug.Print dblQuantity
    Debug.Print dblPrice
End Sub

Public Function getCurrency(p As String) As String
    Dim i As Integer
    i = 1
    Do Until IsNumeric(Mid(p, i, 1)) = True
        i = i + 1
    Loop
    i = i - 1
    getCurrency = Left(p, i)
End Function
 

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
7,117
Hi Gasman

It still tells me

Although the preview displays correctly.
I have 3 urls to show as examples outside of the code area

Your content can not be submitted. This is likely because your content is spam-like or contains inappropriate elements. Please change your content or try again later. If you still have problems, please contact an administrator.
You cannot post links until you have 10 posts. This is to prevent spammers. Try and break the link with a space or remove the http://www. as below for this thread.

access-programmers.co.uk/forums/threads/get-two-bits-of-data-from-microsoft-web-browser-control-access-2007.313835/#post-1720459
 

jeffreylewis

New member
Local time
Today, 12:03
Joined
Sep 17, 2020
Messages
7
see if this modified code will work for you:
Code:
Private Sub Command1_Click()
    Dim ipos As Long
    Dim dblQuantity As Double
    Dim dblPrice As Double
    Dim strQuantity As String
    Dim strCurrency As String
    Dim strPrice As String
    Dim HTML As String

    HTML = Me.WebBrowser0.Object.Document.documentElement.OuterHtml

    'check if class showPrice is present
    ipos = InStr(1, HTML, "<strong class=""showPrice""")
    If ipos > 0 Then
        'showPrice is present
        ipos = InStr(ipos, HTML, ">")
        HTML = Mid(HTML, ipos + 1)
        ipos = InStr(1, HTML, "<")
        strPrice = Trim(Left(HTML, ipos - 1))
        strCurrency = getCurrency(strPrice)
        dblPrice = CDbl(Replace(strPrice, strCurrency, ""))
    End If
   
    'check first if the textbox is present
    ipos = InStr(HTML, "<input name=""Quantity""")
    If ipos > 0 Then
        'textbox is present
        'get the Value for Quantity
        ipos = InStr(ipos, HTML, "value=")
        HTML = Mid(HTML, ipos + Len("value="))
        ipos = InStr(1, HTML, "></div>")
        'this is the quantity
        strQuantity = Trim(Left(HTML, ipos - 1))
        Do While InStr(1, strQuantity, """") > 0
            strQuantity = Replace(strQuantity, """", "")
        Loop
        dblQuantity = CDbl(strQuantity)
    End If
    Debug.Print dblQuantity
    Debug.Print dblPrice
End Sub

Public Function getCurrency(p As String) As String
    Dim i As Integer
    i = 1
    Do Until IsNumeric(Mid(p, i, 1)) = True
        i = i + 1
    Loop
    i = i - 1
    getCurrency = Left(p, i)
End Function

Thanks
But in the Field "showPrice" I do not seem to be picking up the correct element from the website.
tinyurl.com/y2wsnsxn

In the Field "quantity" it seems a little more complex than I at first thought
The website hides the quantity field when out of stock as in this item as in the example below
tinyurl.com/y5pz68ll

Or it displays "qty 1" when it is in stock as in the example below
tinyurl.com/y2wsnsxn
 

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
7,117
Walk through the code line by line with F8 and see what the code actually does.

It *seems* correct to me, but debugging it, will be the real test.?
 

arnelgp

error reading drive A:
Local time
Today, 20:03
Joined
May 7, 2009
Messages
10,855
see this sample.
 

Attachments

  • webScrape.zip
    25.8 KB · Views: 21

Users who are viewing this thread

Top Bottom