How to solve "error 70 permission denied"? - vba

Question

Example of what code do for day 20/04/2019
I'm trying to scrape some odds from oddsportal for some leagues. But since I open too many links, after some time my code stops and shows me the following error:
Run-time error '70': Permission denied.
I tried putting some delay in the code but the error persists. Could someone please help me?
Sub test()
Dim IE() As Object
Dim IE1 As Object
Dim doc As HTMLDocument
Dim link1x2 As String
Dim linkover As String
Dim linkbtts As String
''Novo código
Set IE1 = CreateObject("InternetExplorer.Application")
IE1.Visible = False
IE1.Navigate "https://www.oddsportal.com/matches/soccer/20190420"
Do While IE1.Busy Or IE1.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE1.Document
Set jogos = doc.getElementsByClassName("deactivate")
ReDim IE(0 To jogos.Length * 3)
i = 2
j = 0
For Each jogo In jogos
URL = jogo.Children(1).Children(0).href
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set IE(j) = CreateObject("InternetExplorer.Application")
link1x2 = URL & "#1X2;2"
IE(j).Visible = False
IE(j).Navigate link1x2
Do While IE(j).Busy Or IE(j).ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE(j).Document
Set equipas = doc.getElementById("col-content").Children(0)
Set liga = doc.getElementsByClassName("home")(0).Children(0).Children(3)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For k = 1 To 25
If liga.innerText = Worksheets("Plan2").Range("A" & k) Then
Worksheets("Plan1").Range("M" & i) = liga.innerText
Worksheets("Plan1").Range("A" & i) = equipas.innerText
oddH = doc.getElementsByClassName("aver")(0).Children(1).innerText
oddD = doc.getElementsByClassName("aver")(0).Children(2).innerText
oddA = doc.getElementsByClassName("aver")(0).Children(3).innerText
Worksheets("Plan1").Range("C" & i) = oddH
Worksheets("Plan1").Range("D" & i) = oddD
Worksheets("Plan1").Range("E" & i) = oddA
Set IE(j + 1) = CreateObject("InternetExplorer.Application")
linkbtts = URL & "#bts;2"
IE(j + 1).Visible = False
IE(j + 1).Navigate linkbtts
Do While IE(j + 1).Busy Or IE(j + 1).ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE(j + 1).Document
oddBTTS = doc.getElementsByClassName("aver")(0).Children(1).innerText
oddNBTTS = doc.getElementsByClassName("aver")(0).Children(2).innerText
Worksheets("Plan1").Range("G" & i) = oddBTTS
Worksheets("Plan1").Range("H" & i) = oddNBTTS
IE(j + 1).Quit
Set IE(j + 2) = CreateObject("InternetExplorer.Application")
linkover = URL & "#over-under;2;2.50;0"
IE(j + 2).Visible = False
IE(j + 2).Navigate linkover
Do While IE(j + 2).Busy Or IE(j + 2).ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE(j + 2).Document
oddover = doc.getElementsByClassName("aver")(0).Children(2).innerText
oddunder = doc.getElementsByClassName("aver")(0).Children(3).innerText
Worksheets("Plan1").Range("J" & i) = oddover
Worksheets("Plan1").Range("K" & i) = oddunder
IE(j + 2).Quit
i = i + 1
End If
Next k
IE(j).Quit
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
Application.Wait DateAdd("s", 1, Now)
j = j + 1
Next jogo
End Sub

Answer 1

tl;dr;
One of the immediately obvious issues is the repeated creation of IE instances when only one is needed. Permission denied can occur for a number of reasons including not handling/disposing of objects properly.
The following shows you how to:
Work more efficiently with a single IE instance
Use a helper function to gather all the urls to visit and filter on countries of interest
Correctly retrieve liga value and assign country to a country variable
Navigate to pages and between tabs accurately. Simply concatenating a suffix e.g. #bts;2 did not prove reliable for me with page almost always defaulting to default tab of #1X2;2. Below clicks/use of events are deployed to achieve the required navigation
Apply condition based waits for content to be present with a timed loop demonstrated as well as a loop waiting for change in attribute value
Reduce I/O and significantly boost execution time by storing results in an array and writing that array, results, out once to the sheet. Writing an item at a time to the sheet is an expensive I/O operation
Use faster CSS selectors which modern browsers are optimised for
Caveats:
Tested with all links but there is scope for tightening up the code
It is likely you may need to have a condition based wait for each event (clicking/FireEvent) on the page. I have demonstrated a variety of these.
Example contents of results array (1 index expanded) :
Empty indices are deliberately left to reflect desired output format. One additional column for country is added at end.
Example output:
Requirements:
VBE > Tools > References > Add reference to Microsoft HTML Object Library
VBA:
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub GetOddsInfo()
Dim ie As New InternetExplorer, url As String, matches()
Dim i As Long, results(), ws As Worksheet, headers()
Const MAX_WAIT_SEC As Long = 10
url = "https://www.oddsportal.com/matches/soccer/20190423/"
Set ws = ThisWorkbook.Worksheets("Plan1")
headers = Array("Jogo", vbNullString, "Home Odds", "Draw odds", "Away Odds", vbNullString, "BTT", _
"NBTT", vbNullString, "O2", "U2", vbNullString, "Liga", "Country")
With ie
.Visible = True
.Navigate2 url
While .Busy Or .readyState < 4: DoEvents: Wend
matches = GetMatches(url, .document)
ReDim results(1 To UBound(matches, 1), 1 To 14)
For i = LBound(matches, 1) To UBound(matches, 1)
.Navigate2 matches(i, 4) ' default is "#1X2;2"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim equipas As String, liga As String, averages As Object, oddH As String, oddD As String, oddA As String
Dim country As String
country = matches(i, 1)
liga = matches(i, 2)
equipas = matches(i, 3)
Set averages = .document.querySelectorAll(".aver td")
oddH = "'" & averages.item(1).innerText 'to ensure odds are correctly formatted on output
oddD = "'" & averages.item(2).innerText
oddA = "'" & averages.item(3).innerText
Set averages = Nothing
If .document.querySelectorAll("[onclick*='uid\(13\)'], [onmousedown*='uid\(13\)']").Length > 1 Then
On Error Resume Next
.document.querySelector("[onclick*='uid\(13\)']").FireEvent "onclick" 'both teams to score
.document.querySelector("[onmousedown*='uid\(13\)']").FireEvent "onmousedown"
On Error GoTo 0
While .Busy Or .readyState < 4: DoEvents: Wend
Dim oddBtts As String, oddNbtts As String, t As Date
t = Timer
Do
On Error Resume Next
Set averages = .document.querySelectorAll(".aver td")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While averages.Length < 2
If averages.Length > 1 Then
oddBtts = "'" & averages.item(1).innerText
oddNbtts = "'" & averages.item(2).innerText
End If
Else
oddBtts = "No odds"
oddNbtts = "No odds"
End If
Set averages = Nothing
Dim oddOver As String, oddUnder As String
If .document.querySelector("#bettype-tabs li:nth-of-type(5)").getAttribute("style") = "display: block;" Then
.document.querySelector("#bettype-tabs li:nth-of-type(5) span").FireEvent "onmousedown" 'over/under
Do
Loop Until .document.querySelector(".table-chunk-header-dark").getAttribute("style") = "display: block;"
If .document.querySelectorAll("[onclick*='P-2.50-0-0']").Length = 0 Then
oddOver = "No odds"
oddUnder = "No odds"
Else
.document.querySelector("[onclick*='P-2.50-0-0']").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set averages = .document.querySelectorAll(".aver td")
oddOver = "'" & averages.item(2).innerText
oddUnder = "'" & averages.item(3).innerText
End If
Else
oddOver = "No odds"
oddUnder = "No odds"
End If
Set averages = Nothing
Dim resultsPositions(), resultsOrder(), j As Long
resultsPositions = Array(1, 3, 4, 5, 7, 8, 10, 11, 13, 14) 'columns in output
resultsOrder = Array(equipas, oddH, oddD, oddA, oddBtts, oddNbtts, oddOver, oddUnder, liga, country)
For j = LBound(resultsPositions) To UBound(resultsPositions)
results(i, resultsPositions(j)) = resultsOrder(j)
Next
'If i = 5 Then Stop ''for testing
Next
.Quit
End With
With ws
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetMatches(ByVal url As String, ByVal doc As Object) As Variant
Dim results(), i As Long, listings As Object, html As HTMLDocument
Dim countries(), liga As String, country As String, equipas As String, include As Boolean
Set html = New HTMLDocument
countries = Array("Argentina", "Austria", "Belgium", "Brazil", "China", "Denmark", "England", _
"Finland", "France", "Germany", "Greece", "Ireland", "Italy", "Japan", "Netherlands", "Norway", _
"Poland", "Portugal", "Russia", "Scotland", "Spain", "Sweden", "Switzerland", "Turkey", "USA")
Set listings = doc.querySelectorAll("#table-matches tr")
Dim games As Object, r As Long
Set games = doc.querySelectorAll(".table-participant a")
ReDim results(1 To games.Length, 1 To 4) 'country, liga, equipas, url
For i = 0 To listings.Length - 1
html.body.innerHTML = listings.item(i).innerHTML
Select Case listings.item(i).className
Case "dark center"
country = Trim$(html.querySelector(".bfl").innerText)
liga = html.querySelector(".bflp + a").innerText
include = Not IsError(Application.Match(country, countries, 0))
Case "odd deactivate"
If include Then
r = r + 1
results(r, 1) = country
results(r, 2) = liga
results(r, 3) = html.querySelector("a").innerText
results(r, 4) = Replace$(html.querySelector("a").href, "about:", "https://www.oddsportal.com")
End If
Case " deactivate"
If include Then
r = r + 1
results(r, 1) = country
results(r, 2) = liga
results(r, 3) = html.querySelector("a").innerText
results(r, 4) = Replace$(html.querySelector("a").href, "about:", "https://www.oddsportal.com")
End If
End Select
Next
results = Application.Transpose(results)
ReDim Preserve results(1 To UBound(results, 1), 1 To r)
results = Application.Transpose(results)
GetMatches = results
End Function