使用 VBA 在 Excel 中导入 Web 数据

Question

我想将 MutualFundsPortfolioValues 导入 Excel。我不知道如何从网站导入数据，我需要在所选公司的 2 个不同日期内将网络数据导入 Excel ..

当我在 B3 和 B4 单元格中输入日期并单击 Commandbutton1 时，Excel 可能会将所有数据从我的网页导入我的 Excel 工作表“结果”

例如：

date 1: 04/03/2013 <<<< " it will be in sheets "input" cell B3
date 2 : 11/04/2013 <<<<< " it will be in sheet "input " cell B4
choosen companies <<<<<< its Range "B7: B17"

我添加了一个示例 excel 工作表和网页的打印屏幕.. 有什么想法吗？

我的网页网址：

http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0

Excel 示例和数据示例图片： http://uploading.com/folders/get/b491mfb6/excel-web-query

Answer 1

这是使用 IE 自动化导入数据的代码。

输入参数（如下图在Sheet1中输入）
开始日期 = B3
结束日期 = B4
Şirketler = B5（它允许出现在 B5 下方的多个值，依此类推）

页面查看源输入文件

代码的工作原理：

• 代码创建 Internet Explorer 对象并导航到 site
• 等待页面完全加载并准备就绪。 (IE.readystate)
• 创建对象 html 类
• 输入 Sheet1 中输入字段的值 (txtDateBegin,txtDateEnd , lstCompany)
• 点击提交按钮
• 遍历表 dgFunds 的每一行并转储到 excel Sheet2 中

代码：

   Dim IE As Object
Sub Website()


    Dim Doc As Object, lastRow As Long, tblTR As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True

navigate:
    IE.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"

    Do While IE.readystate <> 4: DoEvents: Loop

    Set Doc = CreateObject("htmlfile")
    Set Doc = IE.document

    If Doc Is Nothing Then GoTo navigate

    Set txtDtBegin = Doc.getelementbyid("txtDateBegin")
    txtDtBegin.Value = Format(Sheet1.Range("B3").Value, "dd.MM.yyyy")

    Set txtDtEnd = Doc.getelementbyid("txtDateEnd")
    txtDtEnd.Value = Format(Sheet1.Range("B4").Value, "dd.MM.yyyy")


    lastRow = Sheet1.Range("B65000").End(xlUp).row
    If lastRow < 5 Then Exit Sub

    For i = 5 To lastRow

        Set company = Doc.getelementbyid("lstCompany")
        For x = 0 To company.Options.Length - 1
            If company.Options(x).Text = Sheet1.Range("B" & i) Then
                company.selectedIndex = x

                Set btnCompanyAdd = Doc.getelementbyid("btnCompanyAdd")
                btnCompanyAdd.Click
                Set btnCompanyAdd = Nothing

                wait
                Exit For
            End If
        Next
    Next


    wait

    Set btnSubmit = Doc.getelementbyid("btnSubmit")
    btnSubmit.Click

    wait

    Set tbldgFunds = Doc.getelementbyid("dgFunds")
    Set tblTR = tbldgFunds.getelementsbytagname("tr")



    Dim row As Long, col As Long
    row = 1
    col = 1

    On Error Resume Next

    For Each r In tblTR

        If row = 1 Then
            For Each cell In r.getelementsbytagname("th")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        Else
            For Each cell In r.getelementsbytagname("td")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        End If
    Next

    IE.Quit
    Set IE = Nothing

    MsgBox "Done"

End Sub

Sub wait()
    Application.wait Now + TimeSerial(0, 0, 10)
    Do While IE.readystate <> 4: DoEvents: Loop
End Sub

输出表在第 2 页中

HTH

Answer 2

你可以read about it by clicking here然后使用宏记录器来记录这样做，这会给你一些代码来使用，如果你需要更多帮助，请询问

还有一个关于 Stack Overflow 的问题：Importing data from web page with diffrent Dates in excel using VBA code

基本上，您将向 Excel 中活动工作表的 QueryTables 集合添加一个 QueryTable 对象。

这里是查询表的 MSDN 参考：MSDN Library: Excel 2007 Querytables Add method