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? Thanks in advance.

回答1:

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

来源：https://stackoverflow.com/questions/51377711/web-contents-update-url-in-a-for-loop-vba

标签

excel-vba