Solved scrapping details from a web site (1 Viewer)

[murray83]

so am/have been making a database for my game cllection and rather then have to check the current price online, could i get it so when on the quick search option when you search for a game it would also display the prices from a site like price charting or similar

database is attached for example

 

[theDBguy]

It would be best if you could find a price source that provides an API to get that information.

 

[murray83]

Someting like this ( but python which i thikn this is, is beyone me at the mo ) https://github.com/markfoster314/Pricecharting-Scraper

 

[Edgar_]

I downloaded your list and was able to scrape that price charting website. I put a listbox there, populated it with the results of the scraping. I did not handle when it does not find anything, but when it does, it returns a messagebox with the count of hits and then it displays the prices on the listbox.

The code would look like this:

Private Sub SearchPriceCharting(game As String)
    Dim res As String
    Dim doc As HTMLDocument
    Dim req As Object: Set req = CreateObject("msxml2.xmlhttp")
    Dim url As String: url = "https://www.pricecharting.com/search-products?type=prices&q=" & game
    Dim i As Long, tableBody As HTMLTableSection, gamesCount As Long, j As Long, rw As String
    Me.lstPrices.RowSource = ""
    Me.lstPrices.RowSourceType = "Value List"
    Me.lstPrices.ColumnCount = 5
    Me.lstPrices.ColumnWidths = "6 cm; 0 cm; 0 cm; 0 cm; 2 cm"
    Set doc = New HTMLDocument
    With req
        .Open "GET", url, False
        .send
        res = .responseText
        doc.body.innerHTML = .responseText
        Set tableBody = doc.getElementById("games_table").Children(1)
        gamesCount = tableBody.childElementCount
        MsgBox gamesCount
        For i = 0 To gamesCount - 1
            For j = 1 To 5
                rw = rw & tableBody.Children(i).Children(j).innerText & ";"
            Next j
            Me.lstPrices.AddItem rw
            rw = ""
        Next i
        
    End With
End Sub

You can customize the column widths if you want to show the other columns from each search result.

I think it can give you a good start if you want to return the prices from other places.

An API would work too.

The naming of your games can get in the way, you'd have to handle that.

 

[murray83]

I downloaded your list and was able to scrape that price charting website. I put a listbox there, populated it with the results of the scraping. I did not handle when it does not find anything, but when it does, it returns a messagebox with the count of hits and then it displays the prices on the listbox.

The code would look like this:

Private Sub SearchPriceCharting(game As String)
    Dim res As String
    Dim doc As HTMLDocument
    Dim req As Object: Set req = CreateObject("msxml2.xmlhttp")
    Dim url As String: url = "https://www.pricecharting.com/search-products?type=prices&q=" & game
    Dim i As Long, tableBody As HTMLTableSection, gamesCount As Long, j As Long, rw As String
    Me.lstPrices.RowSource = ""
    Me.lstPrices.RowSourceType = "Value List"
    Me.lstPrices.ColumnCount = 5
    Me.lstPrices.ColumnWidths = "6 cm; 0 cm; 0 cm; 0 cm; 2 cm"
    Set doc = New HTMLDocument
    With req
        .Open "GET", url, False
        .send
        res = .responseText
        doc.body.innerHTML = .responseText
        Set tableBody = doc.getElementById("games_table").Children(1)
        gamesCount = tableBody.childElementCount
        MsgBox gamesCount
        For i = 0 To gamesCount - 1
            For j = 1 To 5
                rw = rw & tableBody.Children(i).Children(j).innerText & ";"
            Next j
            Me.lstPrices.AddItem rw
            rw = ""
        Next i
      
    End With
End Sub

You can customize the column widths if you want to show the other columns from each search result.

I think it can give you a good start if you want to return the prices from other places.

An API would work too.

The naming of your games can get in the way, you'd have to handle that.

wow cheers i shall look at that, thanks a million

did it work for any of my games listed as just looking now and keep getting the attached but cant see anything missing an end ?

 

[Edgar_]

It worked for some games, I did not handle the 'not found' view.

Which line is highlighted with the error?

 

[murray83]

It worked for some games, I did not handle the 'not found' view.

Which line is highlighted with the error?

it was this line

 

[Edgar_]

I added a little check for when the response does not contain the string id="games_table" and modified the code slightly. I tested it with a bunch of games and it did not throw an error. Also, tested on A2016 and A2021.

Private Sub SearchPriceCharting(game As String)
   
    Dim res As String
    Dim doc As HTMLDocument
    Dim req As Object: Set req = CreateObject("msxml2.xmlhttp")
    Dim url As String: url = "https://www.pricecharting.com/search-products?type=prices&q=" & game
    Dim i As Long, tableBody As HTMLTableSection, gamesCount As Long, j As Long, rw As String
    Me.lstPrices.RowSource = ""
    Me.lstPrices.RowSourceType = "Value List"
    Me.lstPrices.ColumnCount = 5
    Me.lstPrices.ColumnWidths = "6 cm; 0 cm; 0 cm; 0 cm; 2 cm"
    Set doc = New HTMLDocument
    With req
        .Open "GET", url, False
        .send
        res = .responseText
       
        If InStr(1, res, "id=""games_table""") = 0 Then
            MsgBox "Nothing found"
            Exit Sub
        Else
            doc.body.innerHTML = res
        End If
       
        Set tableBody = doc.getElementById("games_table").Children(1)
        gamesCount = tableBody.childElementCount
        MsgBox gamesCount
        For i = 0 To gamesCount - 1
            For j = 1 To 5
                rw = rw & tableBody.Children(i).Children(j).innerText & ";"
            Next j
            Me.lstPrices.AddItem rw
            rw = ""
        Next i
       
    End With
End Sub

 

[murray83]

which game gave you a result, as all tested so far work and says "nothing found" as you said prob down to how game is named

 

[Edgar_]

I tested here with 007: Blood Stone

Add stops in the code to see what is going on for you. It works well for me, I tested it in two versions of Access. You could post the output of this too:

Private Sub DebugSPC(game As String)
    Dim res As String
    Dim doc As HTMLDocument
    Dim req As Object: Set req = CreateObject("msxml2.xmlhttp")
    Dim url As String: url = "https://www.pricecharting.com/search-products?type=prices&q=" & game
    Debug.Print "url" & vbCrLf & url & vbCrLf & "---------------------------------------" & vbCrLf & vbCrLf
    Set doc = New HTMLDocument
    Debug.Print "doc" & vbCrLf & doc.documentElement.outerHTML & vbCrLf & "---------------------------------------" & vbCrLf & vbCrLf
    With req
        .Open "GET", url, False
        .send
        res = .responseText
        Debug.Print "html" & vbCrLf & Left(res, 2000) & vbCrLf & "---------------------------------------" & vbCrLf & vbCrLf
    End With
End Sub

Just make your combobox use that code.

 

[murray83]

okay, that looks great, but i think the reason i get a blank is my work firewall blocks gamepricing booo

but works in principle, cheers

 

[johar123q]

Saving HTML in a larger project with many moving parts takes a little more work. You'll need to organize the file system and keep track of which HTML was parse, where the parsed data goes, and if the page needs to be re-scraped for updates.