简体   繁体   中英

Web.Contents() update URL in a for loop VBA

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM