Web.Contents()更新for循环VBA中的URL

时间:2018-07-17 09:23:47

标签: excel-vba

我正在努力从股票市场网站导入表格数据。他们以这种方式保存相应年份的股票数据:

<PostBuildEvent>C:\WINDOWS\Microsoft.NET\Framework\v4.0.30319\msbuild.exe $(ProjectDir)\static\myproject\msbuild\minify\minify.targets /p:ProjectDir=$(ProjectDir)</PostBuildEvent>

我想自动化导入数据的过程,因为清单上有400只股票,每只股票都有大约10多个网页内容。这是我从录制宏时得到的代码:

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

我的问题是,当我尝试在URL中放入for循环时,只是为了更改最后一位,我得到了错误的源URL错误。有办法克服吗?预先感谢。

1 个答案:

答案 0 :(得分:0)

如果我是你,我会这样做。与往常一样,随时修改代码以适合您的需求。

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

enter image description here