I am struggling to import table data from a stock market website. They keep the data of a stock from corresponding years in such fashion:
https ://........./stockName1/...../1
https ://........./stockName1/...../2
https ://........./stockName1/...../3
https ://........./stockName1/...../4
...and so on
I'd like to automate the process of importing this data, because there are 400 stocks on the list and each has about 10+ web pages of content. This is the code I got from recording the macro:
Sub Makro5()
Makro5 Makro
ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Źródło = Web.Page(Web.Contents(""https://www.bankier.pl/gielda/notowania/akcje/4FUNMEDIA/wyniki-finansowe/skonsolidowany/kwartalny/standardowy/1""))," & Chr(13) & "" & Chr(10) & " Data0 = Źródło{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Zmieniono typ"" = Table.TransformColumnTypes(Data0,{{"""", type text}, {""II Q 2017"", type text}, {""III Q 2017"", type text}, {""IV Q 2017"", type text}, {""I Q 2018"", " & _
"type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Zmieniono typ"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_0"
.Refresh BackgroundQuery:=False
End With
End Sub
My problem is that, when I try to put a for loop in the URL, just to change the last digit, I got an error of wrong source URL. Is there a way to overcome it?
If I were you, I would do it like this. As always, feel free to modify the code to suit your needs.
Sub Web_Table_Option_One()
Dim xml As Object
Dim html As Object
Dim objTable As Object
Dim result As String
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Dim j As Long
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
ActiveSheet.Cells.Clear
For j = 1 To 9
With xml
.Open "GET", "https://www.bankier.pl/gielda/notowania/akcje/4FUNMEDIA/wyniki-finansowe/skonsolidowany/kwartalny/standardowy/" & j, False
.send
End With
result = xml.responseText
Set html = CreateObject("htmlfile")
html.body.innerHTML = result
Set objTable = html.getElementsByTagName("Table")
For lngTable = 0 To objTable.Length - 1
For lngRow = 0 To objTable(lngTable).Rows.Length - 1
For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
Next lngCol
Next lngRow
ActRw = ActRw + objTable(lngTable).Rows.Length + 1
Next lngTable
Next j
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.