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
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:
Code:
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.
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:
Code:
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.
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.
Rich (BB code):
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
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:
Code:
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
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.