Worf's message, above, reminded me that I had promised an additional version of code, that allowed getting the table from each of the selectors available at the home page of the site (even though I asked MJ SACHOO for some clarifications).
The new code, to be copied into an empty standard vba module of the workbook to be compiled:
Code:
#If VBA7 Then 'STRICTLY ON TOP OF A STANDARD MODULE
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdSHow As Long) As LongPtr
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdSHow As Long) As Long
#End If
Dim mmTB As Long, mmTR As Long, mmTD As Long
Sub GetTablesAUSt(ByRef ISh As Worksheet, ByVal myURL As String, _
Optional ByVal TabInd As Long = 1, _
Optional ByVal ClearSh As Boolean = False)
'See pc-facile • Estrazione dati dal sito dinamico
Dim TabArr, TabTo As Long, IJ As Long, IE As Object, myColl As Object, myItm As Object
Dim I As Long, J As Long, TI As Long, KK As Long, cCL As Long, LastR As Long
Dim FlInfo As Boolean, Rispo, GloMess As String, TabDone As Long
'
FlInfo = True 'or FALSE to avoid poput at runtime
'
'Popup message at runtime?
If FlInfo Then
On Error Resume Next
GloMess = "Starting updating AUL Stock Info"
Rispo = Shell("mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & GloMess & """,7,""Information:"",64))")
On Error GoTo 0
End If
Debug.Print ">>> " & myURL & " - " & Format(Now, "hh:mm:ss")
Debug.Print ISh.Name, TabInd, ClearSh
Set IE = CreateObject("InternetExplorer.Application")
Debug.Print Timer
With IE
.navigate myURL 'Navigate to the page
ShowWindow IE.hwnd, 2 'Minimize, for Scheduled excecution compatibility
.Visible = True
Do While .Busy
' DoEvents: DoEvents
Loop 'Attesa not busy
Debug.Print Timer
Do While .readyState <> 4
' DoEvents
Loop 'Attesa document
End With
'
Debug.Print Timer
Sleep 200
'Select tab
TabArr = Array("filter_price", "filter_performance", "filter_technical", "filter_fundamental")
If TabInd = 0 Then TabTo = 4 Else TabTo = TabInd
For IJ = TabInd To TabTo 'Scan requested Tabs
mmTB = 0: mmTR = 0: mmTD = 0
If ClearSh Then ISh.Cells.ClearContents 'Clear sheet, if requested
If IJ = 0 Then IJ = 1
IE.document.getelementbyid(TabArr(IJ - 1)).Click
Debug.Print TabArr(IJ - 1) & " - " & Format(Now, "hh:mm:ss")
'Popup message at runtime?
If FlInfo Then
On Error Resume Next
GloMess = "Importing " & TabArr(IJ - 1)
Rispo = Shell("mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & GloMess & """,3,""Information:"",64))")
On Error GoTo 0
End If
'
Sleep 100
For KK = 1 To 30 'Max 6 secs wait
Set myColl = IE.document.GETelementsbytagname("tr")
Debug.Print myColl.Length, IJ
If cCL = myColl.Length And cCL > 100 Then Exit For
cCL = myColl.Length
Sleep 300
Next KK
'Get last used row on destination sheet
LastR = 0
On Error Resume Next
LastR = ISh.Cells.Find("*", ISh.Range("A1"), xlValues, , xlByRows, xlPrevious).Row
Debug.Print "LastR=" & LastR
On Error GoTo 0
I = LastR: J = 0: TI = 0
'Write table values on the active sheet:
Set myColl = IE.document.GETelementsbytagname("TABLE")
For Each myItm In myColl 'Scan Available TABLES
mmTB = mmTB + 1: mmTR = 0: mmTD = 0
ISh.Cells(I + 1, 1) = "Table# " & TI + 1
TI = TI + 1: I = I + 1
For Each trtr In myItm.Rows 'Scan available rows
mmTR = mmTR + 1
For Each tdtd In trtr.Cells 'Scan available cells
mmTD = mmTD + 1
ISh.Cells(I + 1, J + 1) = tdtd.innerText
J = J + 1
Next tdtd
I = I + 1: J = 0
' DoEvents
Next trtr
I = I + 1
Debug.Print "MM??", mmTB, mmTR, mmTD
If TabDone > 0 Then Exit For
Next myItm
If ISh.Index < ThisWorkbook.Sheets.Count Then
Set ISh = ThisWorkbook.Sheets(ISh.Index + 1)
End If
TabDone = TabDone + 1
Next IJ
If FlInfo Then
On Error Resume Next
Debug.Print "Completed" & " - " & Format(Now, "hh:mm:ss")
GloMess = "Completed AUL Stock Info"
Rispo = Shell("mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & GloMess & """,1,""Information:"",64))")
On Error GoTo 0
End If
'
'Chiusura IE
IE.Quit
Debug.Print "Quit"
Set IE = Nothing
Debug.Print "--------------------------END"
End Sub
This is a subroutine that has to be recalled from a main macro, that must "pass" the following parametres:
a) the sheet where the Tables will be loaded, as Worksheet
b) the url of the destination site, as String; the code is pecialized for the AUL Stock market, the only valid parametre is
Australia Stock Market - Investing.com AU
c) the site "Tab number" to be imported, as Long. 0 means "all the tabs", 1 means the "Price" tab, 2 means the "Performance" tab, on so on with 3 and 4
So the same code can import either one or four set of tables (each "set" includes all the tables in a Tab).
Since my choice was that each Tab will be imported in its own worksheet, the parametre passed in a) means "the first worksheet where the first set of tables will be loaded"; the "next" tab (if the choice is 0=all the 4 tabs) will be imported into the "next" sheet: next means the one whose tab is at right of the current sheet. Beware of this. Also, in case that there is not a "next" sheet then the current one will be used again for the subsequent set of tables.
d) Clear sheet before importing, as Boolean. If True then the sheet will be first cleared then updated values will be imported; if False then new values will be appended to the existing ones
Parametres c) and d) are optional, and their default values are 1 (import only Price tab) and False (do not clear, but append new values)
As said, the above subroutine need to be called from a main macro. For my tests I used:
Code:
Sub CallAUStock()
Call GetTablesAUSt(ThisWorkbook.Sheets("Foglio1"), "https://au.investing.com/equities/australia", 0, True) '<<< Your Url
ThisWorkbook.Sheets("Foglio1").Range("A:Z").WrapText = False
End Sub
This will load into Foglio1 and the "next" 3 sheets the four set of tables available on the 4 Tabs.
HOWEVER each tab contains one specific , long, table and 8 other tables that don't change when switching from tab Price to other tabs. Therefore the full set of tables will be collected only on the first tab imported (either the Price tab, if 1 or 0 is selected in parametre C; or the choosed single tab)
The macro CallAUStock can be excecuted time by time to refresh the stock values; it is therefore important that the sheet passed as parametre a) belongs to "ThisWorksheet" (ie the worksheet that hosts the macro), otherwise "current workbook" would be used; that's why in my CallAUStock I used ThisWorkbook.Sheets("MySheet").
However the macro takes several seconds to be completed, and during this time excel become unusable; I was not able to cut the excecution time, as most of the delay occours (in my testing) before the "IE Document" be declared "completed" (ie the page has been fully assembled). So I don't know how practical is rescheduling it (using the OnTime method) every N minutes.
To make aware the user of what is going on I created some pop-up messages that should appear in foreground, that disapper after few second and anywhay that don't interfere with other applications (excel is frozen during the macro excecution)
The code indeed contains several "DoEvents" that were intended to prevent this freeze, but then I realized that macros (any macro) just abort its flow as soon Excel enter the Edit Mode, i.e. when you type from the keyboard, or delete or anyway you edit cells. So eventually I removed (or better: "I commented") the DoEvents instruction to make sure the macro be completed.
In conclusion, I am afraid that what I got is working prototype rather then a finished product
Bye