Excel for VBA循环中的Web.Contents（）更新URL

我正在努力从股票市场网站导入表格数据。它们以如下方式保存相应年份的股票数据：

https ://........./stockName1/...../1  
https ://........./stockName1/...../2  
https ://........./stockName1/...../3  
https ://........./stockName1/...../4
...and so on

我想自动化导入这些数据的过程，因为列表上有400只股票，每只股票都有10多个网页的内容。这是我录制宏时得到的代码：

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

---

我的问题是，当我试图在URL中加入for循环，只是为了更改最后一位数字时，我得到了一个错误的源URL。有办法克服它吗？

如果我是你，我会这样做。和往常一样，可以随意修改代码以满足您的需要

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

---

我将此代码复制粘贴到一个空项目中，并打开了这些附加引用，但出现了一个错误“运行时错误9.下标超出范围”。总之，这是一种完全不同的全新方法，感谢您的回复！这种错误意味着您正在引用某种对象，但该对象是任务，或命名为与您所引用对象不同的对象。当您出现错误时，哪一行高亮显示为黄色？也许你没有一张没有引号的“Sheet1”表格。确保您有一个“Sheet1”，或更改VBA代码中的名称以点击要将数据转储到的工作表，然后重新运行。它会起作用的。