Snel gegevens ophalen van het web ook wel webscraping genoemd. We surfen daarvoor naar:
https://www.autoscout24.de/lst/ford/granada?sort=standard&desc=0&ustate=N%2CU&atype=C&cy=D&ocs_listing=include&source=homepage_search-mask
en willen de prijzen van de old-timer Ford Granada downloaden. Simpel. Onderstaande code kopiëren en in een moduleblad plakken en op F5 slaan. We halen de title en de prijs op.
Lees onderstaande rode gedeelte goed
‘*****************************************************
‘Geef een verwijzing op naar:
‘Microsoft HTML Object Library
‘Te bereiken via: Alt+F11 | Extra | Verwijzingen
‘*****************************************************
Option Explicit
'Tools->Refernces Microsoft HTML Object Library
'MSDN - URLDownloadToFile function - https://msdn.microsoft.com/en-us/library/ms775123(v=vs.85).aspx
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub Find_Ford_Granada()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sLocalFilename As String
sLocalFilename = Environ$("TMP") & "\urlmon.html"
Dim sURL As String
sURL = "https://www.autoscout24.de/lst/ford/granada?sort=standard&desc=0&ustate=N%2CU&atype=C&cy=D&ocs_listing=include&source=homepage_search-mask"
Dim bOk As Boolean
bOk = (URLDownloadToFile(0, sURL, sLocalFilename, 0, 0) = 0)
If bOk Then
If fso.FileExists(sLocalFilename) Then
'Tools->References Microsoft HTML Object Library
Dim oHtml4 As MSHTML.IHTMLDocument4
Set oHtml4 = New MSHTML.HTMLDocument
Dim oHtml As MSHTML.HTMLDocument
Set oHtml = Nothing
'IHTMLDocument4.createDocumentFromUrl
'MSDN - IHTMLDocument4 createDocumentFromUrl method - https://msdn.microsoft.com/en-us/library/aa752523(v=vs.85).aspx
Set oHtml = oHtml4.createDocumentFromUrl(sLocalFilename, "")
'need to wait a little whilst the document parses
'because it is multithreaded
While oHtml.readyState <> "complete"
DoEvents 'do not comment this out it is required to break into the code if in infinite loop
Wend
Debug.Assert oHtml.readyState = "complete"
Dim sTest As String
sTest = Left$(oHtml.body.outerHTML, 100)
Debug.Assert Len(Trim(sTest)) > 50 'just testing we got a substantial block of text, feel free to delete
'You can log the information in a textfile. Uncheck the next line.
'LogInformation (oHtml.body.outerHTML)
'this is where the page specific logic now goes, here I am getting info from Autoscout page
Dim htmlBrand As Object 'MSHTML.DispHTMLElementCollection
Dim htmlPrice As Object 'MSHTML.DispHTMLElementCollection
Set htmlBrand = oHtml.getElementsByTagName("h2")
Set htmlPrice = oHtml.getElementsByClassName("CurrentPrice_price__Ekflz")
Dim lngCounterLoop As Long
For lngCounterLoop = 0 To htmlBrand.Length - 1
Dim vBrand
Dim vPrice
Set vBrand = htmlBrand.Item(lngCounterLoop)
Set vPrice = htmlPrice.Item(lngCounterLoop)
'On Error GoTo err_chk
If vBrand Is Nothing Or vPrice Is Nothing Then
Debug.Print "There are no more car brands Or prices To be found Or available"
Else
Debug.Print vBrand.outerText & " - " & vPrice.outerText
End If
'On Error GoTo 0
Next
End If
End If
'err_chk:
' If Err.Number = 91 Then
' MsgBox "There was an ERROR!!! - " & Err.Number & " : " & Err.Description & vbNewLine & "There are no more brand or price for cars available"
' Else
' MsgBox Err.Number & ":" & Err.Description
'End If
End SubHet resultaat in het zogenaamde immediate window (als je dit window niet ziet, te bereiken via sneltoets Ctrl+G of via View | Immediate window)
Ford Granada 2.8 i V6 Ghia Turnier Klima – SSD- 5.Gang – € 4.890
Ford Granada L – € 7.999
Ford Granada – € 2.500
Ford Granada Dorchester – € 7.999
Ford Granada I Coupé 1.7 V4 nur 67 TKMHU neuH-Zulassung – € 9.450
Ford Granada 2,8i GhiaVOLL-RESTAURIERT – € 18.300
Ford Granada – € 5.290
Ford Granada US Modell 76er Oldtimer H-Kennzeichen 5.0 V8 – € 7.900
Ford Granada GL-GHIA SERVO/SCHIEBEDACH – € 14.900
Ford Granada MK 2 – 2,0 Automatik – erst 78000 Km. – € 7.800
Ford Granada 2.3 Ghia Automatic 2.Hdn. 86 TKM – € 16.500
Ford Granada |H-Kennzeichen|Scheckheft|Klima|AHK – € 9.970
Ford Granada Granada GL / V6 2,0 Motor / 1 HAND – € 4.000
There are no more car brands or prices to be found or available
When you want to log the information in a textfile. Uncheck the next line.
‘LogInformation (oHtml.body.outerHTML)
In the code above and put the code below in the module.
Sub LogInformation(LogMessage As String)
Dim fileNum As Integer
Const LogFileName As String = "C:\temp\textfile.html"
Open "C:\temp\textfile.html" For Output As #1
Close #1
MsgBox "Clear complete"
fileNum = FreeFile ' next file number
Open LogFileName For Append As #fileNum ' creates the file if it doesn't exist
Print #fileNum, LogMessage ' write information at the end of the text file
Close #fileNum ' close the file
End Sub